Télécharger tokaflu.dgibi

Retour à la liste

Numérotation des lignes :

  1. * fichier : tokaflu.dgibi
  2. OPTI ECHO 1;
  3. graph = faux;
  4. **** @ACBLM
  5. DEBPROC @ACBLM VXL*CHPOINT VYL*CHPOINT VZL*CHPOINT TAB1*TABLE ;
  6. *
  7. ********************************************************************
  8. * Procedure de changement de base. On passe de la base cartesienne *
  9. * locale de l'objet modelise a la base cartesienne du maillage. L' *
  10. * axe Y de la base locale est dirige du point de tangence vers le *
  11. * centre du plasma. Alain MOAL (juillet-aout 1995) *
  12. ********************************************************************
  13. *
  14. *--------------- VARIABLES D'ENTREE :
  15. CP = TAB1.'CENTRE_PLASMA' ;
  16. PTG = TAB1.'PT_TGPLASMA' ;
  17. SI ((VALEUR DIME) EGA 2) ;
  18. SI (EXISTE TAB1 <PLAN) ;
  19. IPLAN = TAB1.<PLAN ;
  20. SINON ;
  21. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  22. FINSI ;
  23. FINSI ;
  24. *------------------------------------
  25. *
  26. VECT0 = CP MOINS PTG ;
  27. VX = COOR 1 VECT0 ;
  28. VY = COOR 2 VECT0 ;
  29. *
  30. *---- calcul de l'angle de rotation dans le plan XY
  31. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  32. ANG1 = 0. ;
  33. SINON ;
  34. ANG1 = -1.* (ATG VX VY) ;
  35. FINSI ;
  36. *
  37. SI ((VALEUR DIME) EGA 2) ;
  38. SI (EGA IPLAN 'PHICONS');
  39. * ---- Coupe 2D a Phi constant
  40. VXL1 = VZL ;
  41. VYL1 = VYL ;
  42. VZL1 = VXL * (-1.);
  43. * ---- rotation
  44. VXM = VXL1 * (COS ANG1) + (VYL1 * (-1.) * (SIN ANG1));
  45. VYM = VXL1 * (SIN ANG1) + (VYL1 * (COS ANG1)) ;
  46. VZM = VZL1 ;
  47. FINSI ;
  48. SI (EGA IPLAN 'THETACONS');
  49. * ---- Coupe 2D a Theta constant
  50. * ---- rotation
  51. VXM = VXL * (COS ANG1) + (VYL * (-1.) * (SIN ANG1)) ;
  52. VYM = VXL * (SIN ANG1) + (VYL * (COS ANG1)) ;
  53. VZM = VZL ;
  54. FINSI;
  55. SINON ;
  56. VZ = COOR 3 VECT0 ;
  57. *
  58. * ---- calcul de l'angle de rotation dans le plan Y1Z1
  59. VX1 = VX * (COS ANG1) + (VY * (SIN ANG1)) ;
  60. VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1)) ;
  61. VZ1 = VZ ;
  62. *
  63. SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
  64. ANG2 = 0. ;
  65. SINON ;
  66. ANG2 = ATG VZ1 VY1 ;
  67. FINSI ;
  68. *
  69. * ---- rotations
  70. VXL1 = VXL ;
  71. VYL1 = VYL * (COS ANG2) + (VZL * (-1.) * (SIN ANG2));
  72. VZL1 = VYL * (SIN ANG2) + (VZL * (COS ANG2)) ;
  73. *
  74. VXM = VXL1 * (COS ANG1) + (VYL1 * (-1.) * (SIN ANG1)) ;
  75. VYM = VXL1 * (SIN ANG1) + (VYL1 * (COS ANG1)) ;
  76. VZM = VZL1 ;
  77. FINSI ;
  78. FINPROC VXM VYM VZM ;
  79. **** @ACBML
  80. DEBPROC @ACBML VXM*CHPOINT VYM*CHPOINT VZM*CHPOINT TAB1*TABLE ;
  81. *
  82. **********************************************************************
  83. * Procedure de changement de base. On passe de la base cartesienne *
  84. * du maillage a la base cartesienne locale de l'objet modelise. L' *
  85. * axe Y est dirige du point de tangence vers le centre du plasma. *
  86. * Alain MOAL (juillet-aout 1995) *
  87. **********************************************************************
  88. *
  89. *--------------- VARIABLES D'ENTREE :
  90. CP = TAB1.'CENTRE_PLASMA' ;
  91. PTG = TAB1.'PT_TGPLASMA' ;
  92. SI ((VALEUR DIME) EGA 2) ;
  93. SI (EXISTE TAB1 <PLAN) ;
  94. IPLAN = TAB1.<PLAN ;
  95. SINON ;
  96. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  97. FINSI ;
  98. FINSI ;
  99. *------------------------------------
  100. *
  101. VECT0 = CP MOINS PTG ;
  102. VX = COOR 1 VECT0 ;
  103. VY = COOR 2 VECT0 ;
  104. *
  105. *---- calcul de l'angle de rotation dans le plan XY
  106. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  107. ANG1 = 0. ;
  108. SINON ;
  109. ANG1 = -1.* (ATG VX VY) ;
  110. FINSI ;
  111. *
  112. SI ((VALEUR DIME) EGA 2) ;
  113. * ---- rotation pour aligner l'axe Y avec VECT0
  114. SI (EGA IPLAN 'PHICONS');
  115. * ---- Coupe 2D a Phi constant
  116. VXL1 = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  117. VYL1 = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  118. VZL1 = VZM ;
  119. * ---- Coupe 2D a Phi constant
  120. VXL = VZL1 ;
  121. VYL = VYL1 ;
  122. VZL = VXL1 * (-1.);
  123. FINSI ;
  124. SI (EGA IPLAN 'THETACONS');
  125. * ---- Coupe 2D a Theta constant
  126. * ---- rotation
  127. VXL = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  128. VYL = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  129. VZL = VZM ;
  130. FINSI ;
  131. *
  132. SINON ;
  133. VZ = COOR 3 VECT0 ;
  134. * ---- rotation pour aligner l'axe Y avec VECT0
  135. VXM1 = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  136. VYM1 = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  137. VZM1 = VZM ;
  138. *
  139. VX1 = VX * (COS ANG1) + (VY * (SIN ANG1)) ;
  140. VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1)) ;
  141. VZ1 = VZ ;
  142. *
  143. * ---- calcul de l'angle de rotation dans le plan Y1Z1
  144. SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
  145. ANG2 = 0. ;
  146. SINON ;
  147. ANG2 = ATG VZ1 VY1 ;
  148. FINSI ;
  149. *
  150. VXL = VXM1 ;
  151. VYL = VYM1 * (COS ANG2) + (VZM1 * (SIN ANG2));
  152. VZL = VYM1 * (-1.) * (SIN ANG2) + (VZM1 * (COS ANG2));
  153. *
  154. FINSI ;
  155. *MESS '>>>> @CBMLV' ; LIST VXL ; LIST VYL ; LIST VZL ;
  156. FINPROC VXL VYL VZL ;
  157.  
  158. **** @ACRLM
  159. DEBPROC @ACRLM XL*CHPOINT YL*CHPOINT ZL*CHPOINT TAB1*TABLE ;
  160. *
  161. *******************************************************************
  162. * Procedure de changement de repere. On passe du repere cartesien *
  163. * local de l'objet modelise au repere cartesien du maillage. Le *
  164. * point de tangence au plasma est l'origine du repere local et *
  165. * l'axe Y est dirige vers le centre du plasma. *
  166. * Alain MOAL (juillet-aout 1995) *
  167. *******************************************************************
  168. *
  169. *--------------- VARIABLES D'ENTREE :
  170. CP = TAB1.'CENTRE_PLASMA' ;
  171. PTG = TAB1.'PT_TGPLASMA' ;
  172. SI ((VALEUR DIME) EGA 2) ;
  173. SI (EXISTE TAB1 <PLAN) ;
  174. IPLAN = TAB1.<PLAN ;
  175. SINON ;
  176. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  177. FINSI ;
  178. FINSI ;
  179. *------------------------------------
  180. *
  181. VECT0 = CP MOINS PTG ;
  182. VX = COOR 1 VECT0 ;
  183. VY = COOR 2 VECT0 ;
  184. *
  185. *---- calcul de l'angle de rotation dans le plan XY
  186. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  187. ANG1 = 0. ;
  188. SINON ;
  189. ANG1 = -1.* (ATG VX VY) ;
  190. FINSI ;
  191. *
  192. XPTG = COOR 1 PTG ;
  193. YPTG = COOR 2 PTG ;
  194. *
  195. SI ((VALEUR DIME) EGA 2) ;
  196. SI (EGA IPLAN 'PHICONS');
  197. * ---- Coupe 2D a Phi constant
  198. XL = ZL ;
  199. ZL = ZL * 0.;
  200. * ---- rotation
  201. XL1 = XL * (COS ANG1) + (YL * (-1.) * (SIN ANG1));
  202. YL1 = XL * (SIN ANG1) + (YL * (COS ANG1));
  203. FINSI;
  204. SI (EGA IPLAN 'THETACONS');
  205. * ---- Coupe 2D a Theta constant
  206. * ---- rotation
  207. XL1 = XL * (COS ANG1) + (YL * (-1.) * (SIN ANG1));
  208. YL1 = XL * (SIN ANG1) + (YL * (COS ANG1));
  209. FINSI;
  210. * ---- changement d'origine du repere
  211. XM = XL1 + XPTG ;
  212. YM = YL1 + YPTG ;
  213. ZM = YL1 * 0. ;
  214. SINON ;
  215. VZ = COOR 3 VECT0 ;
  216. ZPTG = COOR 3 PTG ;
  217. *
  218. * ---- calcul de l'angle de rotation dans le plan Y1Z1
  219. VX1 = VX * (COS ANG1) + (VY * (SIN ANG1)) ;
  220. VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1)) ;
  221. VZ1 = VZ ;
  222. *
  223. SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
  224. ANG2 = 0. ;
  225. SINON ;
  226. ANG2 = ATG VZ1 VY1 ;
  227. FINSI ;
  228. *
  229. * ---- rotations
  230. XL1 = XL ;
  231. YL1 = YL * (COS ANG2) + (ZL * (-1.) * (SIN ANG2)) ;
  232. ZL1 = YL * (SIN ANG2) + (ZL * (COS ANG2)) ;
  233. *
  234. XL2 = XL1 * (COS ANG1) + (YL1 * (-1.) * (SIN ANG1)) ;
  235. YL2 = XL1 * (SIN ANG1) + (YL1 * (COS ANG1)) ;
  236. ZL2 = ZL1 ;
  237. *
  238. * ---- changement d'origine du repere
  239. XM = XL2 + XPTG ;
  240. YM = YL2 + YPTG ;
  241. ZM = ZL2 + ZPTG ;
  242. FINSI ;
  243. FINPROC XM YM ZM ;
  244. **** @ACRML
  245. DEBPROC @ACRML XM*CHPOINT YM*CHPOINT ZM*CHPOINT TAB1*TABLE ;
  246. *
  247. *******************************************************************
  248. * Procedure de changement de repere. On passe du repere cartesien *
  249. * du maillage au repere cartesien local de l'objet modelise. Le *
  250. * point de tangence au plasma est l'origine de ce repere et l'axe *
  251. * l'axe Y final est dirige vers le centre du plasma. *
  252. * en 3D l'axe x initial doit etre l'axe toroidal *
  253. * en 2D cas PHICONS l'axe Z initial est l'axe toroidal *
  254. * en 2D cas THETACONS l'axe x initial est l'axe toroidal *
  255. * Alain MOAL (juillet-aout 1995) *
  256. *******************************************************************
  257. *
  258. *--------------- VARIABLES D'ENTREE :
  259. CP = TAB1.'CENTRE_PLASMA' ;
  260. PTG = TAB1.'PT_TGPLASMA' ;
  261. SI ((VALEUR DIME) EGA 2) ;
  262. SI (EXISTE TAB1 <PLAN) ;
  263. IPLAN = TAB1.<PLAN ;
  264. SINON ;
  265. ERRE '>>>> @CRMLC : TAB1.<PLAN n existe pas' ;
  266. FINSI ;
  267. FINSI ;
  268. *------------------------------------
  269. *
  270. VECT0 = CP MOINS PTG ;
  271. VX = COOR 1 VECT0 ;
  272. VY = COOR 2 VECT0 ;
  273. *
  274. *---- calcul de l'angle de rotation dans le plan XY
  275. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  276. ANG1 = 0. ;
  277. SINON ;
  278. ANG1 = -1.* (ATG VX VY) ;
  279. FINSI ;
  280. *
  281. XPTG = COOR 1 PTG ;
  282. YPTG = COOR 2 PTG ;
  283. *
  284. SI ((VALEUR DIME) EGA 2) ;
  285. * ---- changement d'origine du repere
  286. XM1 = XM - XPTG ;
  287. YM1 = YM - YPTG ;
  288. * ---- rotation pour aligner l'axe Y avec VECT0
  289. SI (EGA IPLAN 'PHICONS');
  290. * ---- Coupe 2D a Phi constant
  291. XL = XM1 * (COS ANG1) + (YM1 * (SIN ANG1));
  292. YL = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1));
  293. ZL = XM * 0. ;
  294. *
  295. ZL = XL ;
  296. XL = XL * 0.;
  297. FINSI;
  298. SI (EGA IPLAN 'THETACONS');
  299. * ---- Coupe 2D a Theta constant
  300. XL = XM1 * (COS ANG1) + (YM1 * (SIN ANG1));
  301. YL = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1));
  302. ZL = XM * 0. ;
  303. FINSI ;
  304. *
  305. SINON ;
  306. VZ = COOR 3 VECT0 ;
  307. ZPTG = COOR 3 PTG ;
  308. * ---- changement d'origine du repere
  309. XM1 = XM - XPTG ;
  310. YM1 = YM - YPTG ;
  311. ZM1 = ZM - ZPTG ;
  312. * ---- rotation pour aligner l'axe Y avec VECT0
  313. XM2 = XM1 * (COS ANG1) + (YM1 * (SIN ANG1)) ;
  314. YM2 = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1)) ;
  315. ZM2 = ZM1 ;
  316. *
  317. VX1 = VX * (COS ANG1) + (VY * (SIN ANG1)) ;
  318. VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1)) ;
  319. VZ1 = VZ ;
  320. *
  321. * ---- calcul de l'angle de rotation dans le plan Y1Z1
  322. SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
  323. ANG2 = 0. ;
  324. SINON ;
  325. ANG2 = ATG VZ1 VY1 ;
  326. FINSI ;
  327. *
  328. XL = XM2 ;
  329. YL = YM2 * (COS ANG2) + (ZM2 * (SIN ANG2)) ;
  330. ZL = YM2 * (-1.) * (SIN ANG2) + (ZM2 * (COS ANG2)) ;
  331. *
  332. FINSI ;
  333. *MESS '>>>> @CRMLC : XL' ; LIST XL ; LIST YL ; LIST ZL ;
  334. FINPROC XL YL ZL ;
  335.  
  336. **** @AMPLI
  337. DEBPROC @AMPLI XV*CHPOINT YV*CHPOINT ZV*CHPOINT VALDIM*ENTIER MAIL0*MAILLAGE ;
  338. *
  339. *************************************************************
  340. * Procedure d'adaptation du facteur d'amplification utilise *
  341. * pour visualiser un champ de vecteur sur une geometrie. *
  342. * Alain MOAL (juillet 1995) *
  343. *************************************************************
  344. *
  345. XM = COOR 1 MAIL0 ;
  346. YM = COOR 2 MAIL0 ;
  347. SI (VALDIM EGA 2) ;
  348. ZM = XM * 0. ;
  349. SINON ;
  350. ZM = COOR 3 MAIL0 ;
  351. FINSI ;
  352. *
  353. *---- norme du vecteur
  354. VECNORM = ((XV * XV) + (YV * YV) + (ZV * ZV))**0.5 ;
  355. *
  356. *---- calcul d'une longueur caracteristique du maillage
  357. LONGCAR1 = ABS ((MAXI XM) - (MINI XM)) ;
  358. LONGCAR2 = ABS ((MAXI YM) - (MINI YM)) ;
  359. LONGCAR3 = ABS ((MAXI ZM) - (MINI ZM)) ;
  360. *
  361. SI (VALDIM EGA 2) ;
  362. LONGCAR = MINI (PROG LONGCAR1 LONGCAR2) ;
  363. SINON ;
  364. LONGCAR = MINI (PROG LONGCAR1 LONGCAR2 LONGCAR3) ;
  365. FINSI ;
  366. *
  367. AMPLI0 = LONGCAR / (MAXI VECNORM) / 10.;
  368. *
  369. FINPROC AMPLI0 ;
  370. **** @ANADES
  371.  
  372. DEBPROC @ANADES TAB1*TABLE ;
  373. *
  374. *************************************************
  375. * Procedure (inspiree de @ANALY) permettant de *
  376. * descendre les lignes de champ et de calculer *
  377. * avec une methode analytique exacte les points *
  378. * d'intersection sur le plan de reference pour *
  379. * recuperer les valeurs du flux normalise. *
  380. * Alain MOAL (Fevrier 2001) *
  381. *************************************************
  382. *
  383. MESS '---------------------------------> calling @ANADES';
  384. *
  385. *--------------- VARIABLES D'ENTREE :
  386. S_OMBRE = TAB1.LFLUX_EXTE ;
  387. S_OMBRAN = TAB1.<MAILLAGE_FN ;
  388. CHSIGN1 = TAB1.<CHAMP_SIGNE ;
  389. PASB2 = TAB1.<LONGUEUR_PAS_AVEC_TEST ;
  390. DMAX2 = TAB1.<DISTANCE_AVEC_TEST ;
  391. NBPAS2 = TAB1.<NOMBRE_PAS_AVEC_TEST ;
  392. PASB1 = TAB1.<LONGUEUR_PAS_SANS_TEST ;
  393. DMAX1 = TAB1.<DISTANCE_SANS_TEST ;
  394. NBPAS1 = TAB1.<NOMBRE_PAS_SANS_TEST ;
  395. TOL1 = 1.e-9 ;
  396. *------------------------------------
  397. *
  398. * --- PASSAGE EN TRI3 POUR LA PROCEDURE @INTSEC
  399. si (DIME(S_OMBRAN ELEM 'TYPE') EGA 2) ;
  400. stri3 = elem s_ombran tri3 ;
  401. squa4 = elem s_ombran qua4 ;
  402. squtri3 = chan squa4 tri3 ;
  403. s_ombra2 = squtri3 et stri3 ;
  404. sinon ;
  405. s_ombra2 = chan s_ombran tri3 ;
  406. finsi ;
  407. *
  408. * --- CONSTRUCTION DU MAILLAGE DES POINTS A SUIVRE
  409. MAILPTS = MANU POI1 ((chan s_ombre poi1) poin init) ;
  410. TABPTS1 = table ;
  411. TABPTS1 . 1 = (chan s_ombre poi1) poin init ;
  412. npts = 1 ;
  413. tablig1 = table ;
  414.  
  415. * --- CREATION DES 3 CHMELEM DE COORDONNEES AUX ELEMENTS
  416. TAB1.<MAILLAGE = S_OMBRA2 ;
  417. *AM*27/01/04 @RMXYZ TAB1 ;
  418. @RMCOORO TAB1 ;
  419. * --- CALCUL DES NORMALES AUX ELEMENTS SUR LE MAILLAGE OMBRANT
  420. *AM*27/01/04 @AMNORM TAB1 ;
  421. @RMNORM TAB1 ;
  422. * ---- Flux normalise sur le maillage ombrant
  423. @RMFLUN TAB1 ;
  424.  
  425. MESS ' ';
  426. MESS 'WITHOUT TEST';
  427. MESS 'Distance covered :' DMAX1 ;
  428. MESS 'Step :' PASB1 ;
  429. MESS 'Iterations number :' NBPAS1 ;
  430. MESS ' ';
  431. MESS 'WITH TEST';
  432. MESS 'Distance covered :' DMAX2 ;
  433. MESS 'Step :' PASB2 ;
  434. MESS 'Iterations number :' NBPAS2 ;
  435. MESS ' ' ;
  436.  
  437. * --- initialisation du pas
  438. I1 = 0 ;
  439. * ---initialisation de la distance de connexion
  440. CHDIST = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
  441. * --- initialisation du flux normalise
  442. CHFNORM = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
  443. * --- initialisation du maillage ou on va tester les intersections
  444. s_ombre2 = s_ombre ;
  445. * --- initialisation du maillage ou on va remonter les lignes
  446. mailcou = s_ombre2 et mailpts ;
  447. * ---- initialisation des distances
  448. LCOURAN1 = 0. ;
  449. LMAX1 = 0. ;
  450. * ---- coordonnees
  451. XG_OLD = COOR 1 mailcou ;
  452. YG_OLD = COOR 2 mailcou ;
  453. ZG_OLD = COOR 3 mailcou ;
  454. *
  455. * --- initialisation des lignes de champ remontees
  456. REPETER BOUPTS1 NPTS ;
  457. tablig1 . &BOUPTS1 = TABPTS1 . &BOUPTS1 ;
  458. FIN BOUPTS1 ;
  459.  
  460. *--------------------------------------------------------------
  461. *
  462. * DEBUT DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  463. *
  464. *--------------------------------------------------------------
  465. *
  466. * ----- sans test d'interception
  467. PASB0 = PASB1 ;
  468. * increment de la distance de connexion (= PAS tant qu'il n'y a pas
  469. * d'intersection)
  470.  
  471. chdist9 = manu chpo s_ombre2 1 scal pasb0 ;
  472. chfn9 = manu chpo s_ombre2 1 scal 0. ;
  473. *
  474. * initialisation a 0 des deplacements
  475. DEPX0 = XG_OLD * 0. ;
  476. DEPY0 = YG_OLD * 0. ;
  477. DEPZ0 = ZG_OLD * 0. ;
  478. DEPX0 = NOMC UX DEPX0 NATURE DIFFUS ;
  479. DEPY0 = NOMC UY DEPY0 NATURE DIFFUS ;
  480. DEPZ0 = NOMC UZ DEPZ0 NATURE DIFFUS ;
  481. TAB1.<DEPLACEMENT = DEPX0 ET DEPY0 ET DEPZ0 ;
  482.  
  483. SI (NBPAS1 NEG 0) ;
  484. MESS 'WITHOUT INTERCEPTION TEST';
  485. REPETER BOUCLE1 NBPAS1 ;
  486. I1 = I1 + 1 ;
  487. LCOURAN1 = LCOURAN1 + PASB0 ;
  488. MESS ' ';
  489. MESS 'ITERATION : ' I1 'distance covered' LCOURAN1 ;
  490.  
  491. * ---- Appel de la procedure de descente des lignes de champ
  492. XG_NEW YG_NEW ZG_NEW DEP0 = @descend XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1;
  493. FORM DEP0 ;
  494. TAB1.<DEPLACEMENT = TAB1.<DEPLACEMENT + DEP0 ;
  495.  
  496. * --- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  497. chdist = chdist + CHDIST9 ;
  498.  
  499. * --- construction des lignes de champ remontees
  500. * --- Extraction des coordonnees des points a remonter
  501. * xmailpt2 = redu XG_NEW mailpts ;
  502. * ymailpt2 = redu YG_NEW mailpts ;
  503. * zmailpt2 = redu ZG_NEW mailpts ;
  504. *
  505. * --- Construction des lignes de remontee
  506. * repeter boupts2 npts ;
  507. * xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts2) ;
  508. * yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts2) ;
  509. * zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts2) ;
  510. * prem2 = xprem2 yprem2 zprem2 ;
  511. * tablig1.&boupts2 = (tablig1 . &boupts2) d 1 prem2 ;
  512. * fin boupts2 ;
  513.  
  514. * --- actualisation des champs de coordonnees pour iteration suivante
  515. XG_OLD = XG_NEW ;
  516. YG_OLD = YG_NEW ;
  517. ZG_OLD = ZG_NEW ;
  518. MENA ;
  519. FIN BOUCLE1 ;
  520. FINSI ;
  521.  
  522. MESS 'WITH INTERCEPTION TEST';
  523.  
  524. PASB0 = PASB2 ;
  525. s_ombreP = chan s_ombre poi1 ;
  526. s_ombre2 = chan s_ombre poi1 ;
  527. mailcou = s_ombre2 et mailpts ;
  528.  
  529. I2 = 0 ;
  530. I3 = 0 ;
  531. REPETER BOUCLE2 NBPAS2 ;
  532. I1 = I1 + 1 ;
  533. I3 = I3 + 1 ;
  534. SI (NBNO s_ombre2 > 0) ;
  535. * ---- si il reste des noeuds non encore intersectes
  536. LCOURAN1 = LCOURAN1 + PASB0 ;
  537. MESS ' ';
  538. MESS 'ITERATION : ' I1 'distance covered' LCOURAN1 ;
  539.  
  540. * ---- Appel de la procedure de descente des lignes de champ
  541. XG_NEW YG_NEW ZG_NEW DEP0 = @DESCEND XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1 ;
  542.  
  543. * ---- test sur les eventuels noeuds interceptes
  544. * ---- Les CHPO sont reduits sur les points de s_ombre
  545. * ---- qui n'ont pas encore ete intersectes : s_ombre2
  546. XG_OLD_R = REDU XG_OLD S_OMBRE2 ;
  547. YG_OLD_R = REDU YG_OLD S_OMBRE2 ;
  548. ZG_OLD_R = REDU ZG_OLD S_OMBRE2 ;
  549.  
  550. XG_NEW_R = REDU XG_NEW S_OMBRE2 ;
  551. YG_NEW_R = REDU YG_NEW S_OMBRE2 ;
  552. ZG_NEW_R = REDU ZG_NEW S_OMBRE2 ;
  553.  
  554. XG_OLD_R = NOMC X XG_OLD_R 'NATU' 'DIFFUS' ;
  555. YG_OLD_R = NOMC Y YG_OLD_R 'NATU' 'DIFFUS' ;
  556. ZG_OLD_R = NOMC Z ZG_OLD_R 'NATU' 'DIFFUS' ;
  557.  
  558. CH_OLD = XG_OLD_R ET YG_OLD_R ET ZG_OLD_R ;
  559.  
  560. XG_NEW_R = NOMC X XG_NEW_R 'NATU' 'DIFFUS' ;
  561. YG_NEW_R = NOMC Y YG_NEW_R 'NATU' 'DIFFUS' ;
  562. ZG_NEW_R = NOMC Z ZG_NEW_R 'NATU' 'DIFFUS' ;
  563.  
  564. CH_NEW = XG_NEW_R ET YG_NEW_R ET ZG_NEW_R ;
  565. *
  566. * ---- Test d'interception
  567. * CHDIST9 MINTER CHFN9 DEPMP1 = @INTSEC CH_OLD CH_NEW TOL1 TAB1 ;
  568. CHDIST9 MINTER CHFN9 DEPMP1 = IJET CH_OLD CH_NEW TOL1 TAB1 ;
  569.  
  570. * CHDIST9 = CHPO CONTENANT PAS POUR LES NOEUDS INTERSECTES
  571. * ET D(M,PT_REMONTE) SINON
  572.  
  573. * S_OMBRE2 contient les noeuds de s_ombre qui n'ont
  574. * pas ete intesectes
  575. * s_ombre0 contient les noeuds qui ont deja ete intersectes
  576. * minter contient les noeuds qui viennent d'etre intersectes
  577. s_ombre0 = diff s_ombreP s_ombre2 ;
  578. s_ombre2 = diff s_ombre2 MINTER ;
  579.  
  580. TITRE 'TEST : POINTS INTERCEPTES (BLANC ET JAUNE)' ;
  581. TRAC ((s_ombre2 coul roug) et MINTER et (s_ombre0 COUL JAUNE) et TAB1.<GRILLE_B et TAB1.<MAILLAGE_FN) ;
  582. *
  583. DEP01 = REDU DEP0 s_ombre2 ;
  584. DEP02 = MANU CHPO s_ombre0 3 UX 0. UY 0. UZ 0. NATURE DIFFUS ;
  585. SI ((NBNO MINTER) > 0) ;
  586. DEP0 = DEP01 ET DEP02 ET DEPMP1 ;
  587. SINON ;
  588. DEP0 = DEP01 ET DEP02 ;
  589. FINSI ;
  590.  
  591. FORM DEP0 ;
  592.  
  593. * ---- Test
  594. * i9 = 0 ;
  595. * repeter bouc01 (nbno (EXTR DEP0 'MAIL')) ;
  596. * i9 = i9 + 1 ;
  597. * list ((EXTR DEP0 'MAIL') poin i9) ;
  598. * list (redu CHFN9 ((EXTR DEP0 'MAIL') poin i9)) ;
  599. * fin bouc01 ;
  600. * TITRE 'TEST : NOEUDS SUPPORTS DU DEPLACEMENT';
  601. * TRAC (EXTR DEP0 'MAIL') ;
  602. * ---- Fin test
  603.  
  604. TAB1.<DEPLACEMENT = TAB1.<DEPLACEMENT + DEP0 ;
  605.  
  606. * ---- actualisation du maillage de descente
  607. mailcou = s_ombre2 et mailpts ;
  608.  
  609. CHSIGN1 = REDU CHSIGN1 mailcou ;
  610.  
  611. SI ((NBNO MINTER) > 0) ;
  612. mess (NBNO MINTER) 'intercepted points';
  613. LMAX1 = LCOURAN1 - pasb0 + (mini CHDIST9) ;
  614. FINSI ;
  615.  
  616. * ---- Distances parcourues avant interception
  617. chdist = chdist + CHDIST9 ;
  618. chfnorm = chfnorm + chfn9 ;
  619. mess 'mini maxi connection distance (m)' (mini (prog lmax1 (mini chdist))) lmax1 ;
  620. * list chfnorm ;
  621.  
  622. * --- construction des lignes de champ remontees
  623. * --- Extraction des coordonnees des points a remonter
  624. * xmailpt2 = redu XG_NEW mailpts ;
  625. * ymailpt2 = redu YG_NEW mailpts ;
  626. * zmailpt2 = redu ZG_NEW mailpts ;
  627. *
  628. * --- Construction des lignes de descentes
  629. * repeter boupts3 npts ;
  630. * xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts3) ;
  631. * yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts3) ;
  632. * zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts3) ;
  633. * prem2 = xprem2 yprem2 zprem2 ;
  634. * tablig1 . &boupts3 = (tablig1 . &boupts3) d 1 prem2 ;
  635. * fin boupts3 ;
  636.  
  637. * --- actualisation des champs de coordonnees pour iteration suivante
  638. XG_OLD = redu XG_NEW mailcou;
  639. YG_OLD = redu YG_NEW mailcou;
  640. ZG_OLD = redu ZG_NEW mailcou;
  641. MENA ;
  642. sinon ;
  643. SI (I2 EGA 0) ;
  644. MESS ' ';
  645. MESS 'ALL POINTS ARE INTERCEPTED' ;
  646. MESS ' ';
  647. I2 = I1 ;
  648. FINSI ;
  649. finsi ;
  650. FIN BOUCLE2 ;
  651.  
  652. *--- Sorties dans TAB1
  653. TAB1.<CHAMP_DISTANCE = CHDIST ;
  654. TAB1.<LONGUEUR_CONNEXION_MAX = LMAX1 ;
  655. TAB1.<LONGUEUR_PARCOURUE = LCOURAN1 ;
  656.  
  657. *si (exis tab1 <remontee) ;
  658. * tab1 . <remontee . <ligne = tablig1 ;
  659. *finsi ;
  660.  
  661. MESS '---------------------------------> exiting @ANADES';
  662. FINPROC chfnorm ;
  663.  
  664. **** @ANAJET
  665.  
  666. DEBPROC @ANAJET TAB1*TABLE ;
  667.  
  668. MESS '---------------------------------> calling @ANAJET';
  669. MESS 'METHODE ANALYTIQUE' ;
  670. *
  671. *--------------- VARIABLES D'ENTREE :
  672. *
  673.  
  674. S_OMBRE = TAB1.<S_OMBRE ;
  675. S_OMBRAN = TAB1.<S_OMBRANT ;
  676. IMETHOD = TAB1.<METHODE_REMONTEE ;
  677. CHSIGN1 = TAB1.<CHSIGN ;
  678.  
  679.  
  680. si (exis tab1 <remontee) ;
  681. TABPTS1 = TAB1.<REMONTEE.<POINT ;
  682. tablig1 = table ;
  683. finsi ;
  684.  
  685. PASB2 = TAB1.<PAS_AVEC_TEST ;
  686. DMAX2 = TAB1.<DIST_AVEC_TEST ;
  687. NBPAS2 = TAB1.<NBPAS2 ;
  688.  
  689. SI (EXIS TAB1 <PAS_SANS_TEST) ;
  690. PASB1 = TAB1.<PAS_SANS_TEST ;
  691. DMAX1 = TAB1.<DIST_SANS_TEST ;
  692. NBPAS1 = TAB1.<NBPAS1 ;
  693. FINSI ;
  694.  
  695.  
  696. SI (EXIS TAB1 <TOLERANCE) ;
  697. TOL1 = TAB1.<TOLERANCE ;
  698. SINON ;
  699. TOL1 = 1.e-9 ;
  700. FINSI ;
  701.  
  702. *
  703. * --- PASSAGE EN TRI3 POUR LA PROC @INTERC
  704. *
  705.  
  706. LMOT = s_ombran ELEM 'TYPE' ;
  707. ntyp = dime LMOT ;
  708. si (ntyp ega 2) ;
  709. stri3 = elem s_ombran tri3 ;
  710. squa4 = elem s_ombran qua4 ;
  711. squtri3 = chan squa4 tri3 ;
  712. s_ombra2 = squtri3 et stri3 ;
  713. sinon ;
  714. s_ombra2 = chan s_ombran tri3 ;
  715. finsi ;
  716.  
  717.  
  718. * --- CONSTRUCTION DU MAILLAGE DES POINTS A REMONTER
  719. si (exis tab1 <remontee) ;
  720. MAILPTS = MANU POI1 TABPTS1 . 1 ;
  721. NPTS = DIME TABPTS1 ;
  722. REPETER BOUPTS1 (NPTS - 1) ;
  723. MAILPTS = MAILPTS ET TABPTS1 . (&BOUPTS1 + 1) ;
  724. FIN BOUPTS1 ;
  725. sinon ;
  726. * RM 15/06/2000 MAILPTS = MANU POI1 (s_ombre poin init) ;
  727. MAILPTS = MANU POI1 ((chan s_ombre poi1) poin init) ;
  728. TABPTS1 = table ;
  729. TABPTS1 . 1 = (chan s_ombre poi1) poin init ;
  730. npts = 1 ;
  731. tablig1 = table ;
  732. finsi ;
  733.  
  734.  
  735. si (non (tab1.<reprise)) ;
  736. * --- CREATION DES 3 CHMELEM DE COORDONNEES AUX ELEMENTS
  737. * --- Remarque : ces coordonnees seront exprimees dans le repere globale
  738. TAB1.<MAILLAGE = S_OMBRA2 ;
  739. *AM*27/01/04 si (non (exis tab1 <chamx1)) ;
  740. *AM*27/01/04 @AMCOORO TAB1 ;
  741. @RMCOORO TAB1 ;
  742. *AM*27/01/04 finsi ;
  743. * --- CALCUL DES NORMALES AUX ELEMENTS SUR LE MAILLAGE OMBRANT
  744. *AM*27/01/04 si (non (exis tab1 <cosx)) ;
  745. @RMNORM TAB1 ;
  746. *AM*27/01/04 finsi ;
  747. finsi ;
  748.  
  749.  
  750. *
  751. * --- Rappel des parametres de la procedure
  752. *
  753. MESS ' ';
  754. MESS '##################################################';
  755. MESS ' ';
  756. MESS '>@ANAJET> procedure OMBJET, Rappel des parametres de calcul ';
  757. MESS ' ';
  758.  
  759. si (tab1.<reprise) ;
  760. mess 'Reprise d un calcul';
  761. mess '-------------------';
  762. finsi ;
  763.  
  764. SI (IMETHOD EGA 1) ;
  765. METH = 'methode explicite des tangentes';
  766. FINSI ;
  767. SI (IMETHOD EGA 2) ;
  768. METH = 'methode moyenne des tangentes aux extremitee';
  769. FINSI ;
  770. SI (IMETHOD EGA 3) ;
  771. METH = 'methode du point milieu';
  772. FINSI ;
  773. SI (IMETHOD EGA 4) ;
  774. METH = 'methode de reprojection';
  775. FINSI ;
  776. MESS ' ';
  777.  
  778. SI (EXIS tab1 <PAS_SANS_TEST) ;
  779. MESS 'Calcul en deux parties :';
  780. MESS ' ';
  781. MESS 'SANS TEST';
  782. MESS 'Distance remontee :' DMAX1 ;
  783. MESS 'Pas pour la remontee :' PASB1 ;
  784. MESS 'Nombre d iterations :' NBPAS1 ;
  785. MESS ' ';
  786. MESS 'AVEC TEST';
  787. MESS 'Distance remontee :' DMAX2 ;
  788. MESS 'Pas pour la remontee :' PASB2 ;
  789. MESS 'Nombre d iterations :' NBPAS2 ;
  790. SINON ;
  791. MESS 'Calcul avec test systematique :';
  792. MESS 'Distance remontee :' DMAX2 ;
  793. MESS 'Pas de remontee :' PASB2 ;
  794. MESS 'Nombre d iterations :' NBPAS2 ;
  795. FINSI ;
  796. MESS ' ' ;
  797.  
  798. *
  799. *--------------------------------------------------------------
  800. *
  801. * INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  802. * --- CAS SANS REPRISE ---
  803. *--------------------------------------------------------------
  804. si (non (tab1.<reprise)) ;
  805. * --- initialisation du pas
  806. I1 = 0 ;
  807. * ---initialisation de la distance de connexion
  808. CHDIST = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
  809. * --- initialisation du maillage ou on va tester les intersections
  810. s_ombre2 = s_ombre ;
  811. * --- initialisation du maillage ou on va remonter les lignes
  812. mailcou = s_ombre2 et mailpts ;
  813. *---- initialisation des distances
  814. LCOURAN1 = 0. ;
  815. LMAX1 = 0. ;
  816. * ---- coordonnees dans le repere du maillage
  817. XM0 = COOR 1 mailcou ;
  818. YM0 = COOR 2 mailcou ;
  819. ZM0 = COOR 3 mailcou ;
  820. *---- Coordonnees dans le repere global du tore
  821. XG_OLD = XM0 ;
  822. YG_OLD = YM0 ;
  823. ZG_OLD = ZM0 ;
  824.  
  825. *
  826. * --- initialisation des lignes de champ remontees
  827. REPETER BOUPTS1 NPTS ;
  828. tablig1 . &BOUPTS1 = TABPTS1 . &BOUPTS1 ;
  829. FIN BOUPTS1 ;
  830.  
  831. sinon ;
  832. *
  833. *--------------------------------------------------------------
  834. *
  835. * INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  836. * --- CAS AVEC REPRISE ---
  837. *--------------------------------------------------------------
  838. * --- initialisation du pas
  839. I1 = tab1.<i_ombrage ;
  840. * --- initialisation de la distance de connexion
  841. CHDIST = tab1.<chdist;
  842. * --- initialisation du maillage ou on va tester les intersections
  843. s_ombre2 = tab1.<s_omb_non_inter ;
  844. * --- initialisation du maillage ou on va remonter les lignes
  845. mailcou = s_ombre2 et mailpts ;
  846.  
  847.  
  848. *---- initialisation des distances
  849. LCOURAN1 = maxi chdist ;
  850. LMAX1 = tab1.<CONNEXION_MAX ;
  851.  
  852. *---- Coordonnees dans le repere global du tore
  853. XG_OLD = exco X tab1.<CHCOOR0 ;
  854. YG_OLD = exco Y tab1.<CHCOOR0 ;
  855. ZG_OLD = exco Z tab1.<CHCOOR0 ;
  856. *
  857.  
  858. * --- initialisation des lignes de champ remontees
  859. si (exis tab1 <remontee) ;
  860. tablig1 = tab1.<remontee.<ligne ;
  861. sinon ;
  862. tablig1 . 1 = (TABPTS1 . 1) d 1 (TABPTS1.1 plus (0. 0. 0.));
  863. finsi ;
  864.  
  865. finsi ;
  866.  
  867. *--------------------------------------------------------------
  868. *
  869. * DEBUT DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  870. *
  871. *--------------------------------------------------------------
  872. *
  873. MESS ' ';
  874. MESS '##################################################';
  875. MESS ' ';
  876.  
  877. SI (EXIS TAB1 <DIST_SANS_TEST) ;
  878.  
  879. * ------------------ Boucle 1 on remonte sans test -------------------
  880. PASB0 = PASB1 ;
  881. * increment de la distance de connexion (= PAS tant qu'il n'y a pas
  882. * d'intersection)
  883. chdist9 = manu chpo s_ombre2 1 scal pasb0 ;
  884.  
  885. *
  886. * initialisation a 0 des deplacements
  887. DEPX0 = XG_OLD * 0. ;
  888. DEPY0 = YG_OLD * 0. ;
  889. DEPZ0 = ZG_OLD * 0. ;
  890. DEPX0 = NOMC UX DEPX0 NATURE DIFFUS ;
  891. DEPY0 = NOMC UY DEPY0 NATURE DIFFUS ;
  892. DEPZ0 = NOMC UZ DEPZ0 NATURE DIFFUS ;
  893. TAB1.<DEPLACE = DEPX0 ET DEPY0 ET DEPZ0 ;
  894.  
  895. MESS 'PREMIERE PARTIE DU CALCUL, SANS TEST D INTERSECTION';
  896. REPETER BOUCLE1 NBPAS1 ;
  897. I1 = I1 + 1 ;
  898. LCOURAN1 = LCOURAN1 + PASB0 ;
  899. MESS ' ';
  900. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  901.  
  902. * ---- Appel de la procedure de remontee des lignes de champ
  903. XG_NEW YG_NEW ZG_NEW DEP0 = @remojet XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1 ;
  904. FORM DEP0 ;
  905. TAB1.<DEPLACE = TAB1.<DEPLACE + DEP0 ;
  906. TITRE 'SANS TEST, ITERATION : 'I1 ;
  907. TRAC ((s_ombre2 coul roug) ET TAB1.<GRILLE_B ET TAB1.<S_OMBRANT) ;
  908.  
  909. *--- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  910. chdist = chdist + CHDIST9 ;
  911.  
  912.  
  913. *-----------------------------------------------------------------
  914. *--- construction des lignes de champ remontees
  915. * --- Extraction des coordonnees des points a remonter
  916. xmailpt1 = redu XG_NEW mailpts ;
  917. ymailpt1 = redu YG_NEW mailpts ;
  918. zmailpt1 = redu ZG_NEW mailpts ;
  919.  
  920. * --- Calcul des coordonnees des points a remonter dans le repere du maillage
  921. xmailpt2 = xmailpt1 ;
  922. ymailpt2 = ymailpt1 ;
  923. zmailpt2 = zmailpt1 ;
  924.  
  925. *
  926. * --- Construction des lignes de remontee
  927. repeter boupts2 npts ;
  928. xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts2) ;
  929. yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts2) ;
  930. zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts2) ;
  931. prem2 = xprem2 yprem2 zprem2 ;
  932. tablig1.&boupts2 = (tablig1 . &boupts2) d 1 prem2 ;
  933. fin boupts2 ;
  934. **-----------------------------------------------------------------
  935.  
  936.  
  937. * --- actualisation des champs de coordonnees pour iteration suivante
  938.  
  939. XG_OLD = XG_NEW ;
  940. YG_OLD = YG_NEW ;
  941. ZG_OLD = ZG_NEW ;
  942.  
  943. MENA ;
  944.  
  945. FIN BOUCLE1 ;
  946. * ------------------------ Fin de la boucle 1 ------------------------
  947. finsi ;
  948.  
  949.  
  950. MESS ' ';
  951. MESS '##################################################';
  952. MESS ' ';
  953.  
  954. MESS 'CALCUL AVEC TEST D INTERSECTION';
  955.  
  956. * ------------------ Boucle 2 on remonte avec test -------------------
  957. PASB0 = PASB2 ;
  958. si (non (tab1.<reprise)) ;
  959. s_ombre2 = chan s_ombre poi1 ;
  960. mailcou = s_ombre2 et mailpts ;
  961. finsi ;
  962. REPETER BOUCLE2 NBPAS2 ;
  963.  
  964. I1 = I1 + 1 ;
  965. LCOURAN1 = LCOURAN1 + PASB0 ;
  966. MESS ' ';
  967. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  968.  
  969. * ---- Appel de la procedure de remonter des lignes de champ
  970. XG_NEW YG_NEW ZG_NEW DEP0 = @remojet XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1 ;
  971. *---- ------test sur les eventuels noeuds interceptes -----------
  972. *---- seulement s'il reste des noeuds non encore intersectes ----
  973. si (nbno s_ombre2 > 0.) ;
  974.  
  975. * --- Les CHPO sont reduits sur les points de s_ombre
  976. * --- qui n'ont pas encore ete intersectes : s_ombre2
  977.  
  978. XG_OLD_R = REDU XG_OLD S_OMBRE2 ;
  979. YG_OLD_R = REDU YG_OLD S_OMBRE2 ;
  980. ZG_OLD_R = REDU ZG_OLD S_OMBRE2 ;
  981.  
  982. XG_NEW_R = REDU XG_NEW S_OMBRE2 ;
  983. YG_NEW_R = REDU YG_NEW S_OMBRE2 ;
  984. ZG_NEW_R = REDU ZG_NEW S_OMBRE2 ;
  985.  
  986.  
  987. XG_OLD_R = NOMC X XG_OLD_R 'NATU' 'DIFFUS' ;
  988. YG_OLD_R = NOMC Y YG_OLD_R 'NATU' 'DIFFUS' ;
  989. ZG_OLD_R = NOMC Z ZG_OLD_R 'NATU' 'DIFFUS' ;
  990.  
  991. CH_OLD = XG_OLD_R ET YG_OLD_R ET ZG_OLD_R ;
  992.  
  993.  
  994. XG_NEW_R = NOMC X XG_NEW_R 'NATU' 'DIFFUS' ;
  995. YG_NEW_R = NOMC Y YG_NEW_R 'NATU' 'DIFFUS' ;
  996. ZG_NEW_R = NOMC Z ZG_NEW_R 'NATU' 'DIFFUS' ;
  997.  
  998. CH_NEW = XG_NEW_R ET YG_NEW_R ET ZG_NEW_R ;
  999.  
  1000. *
  1001. * --- APPEL DE LA PROCEDURE DE CALCUL DES NOEUDS INTERSECTES
  1002. *
  1003. * CHDIST9 MINTER = @INTERC CH_OLD CH_NEW TOL1 TAB1 ;
  1004. CHDIST9 MINTER = ITRC CH_OLD CH_NEW TOL1 TAB1 ;
  1005.  
  1006. * CHDIST9 = CHPO CONTENANT PAS POUR LES NOEUDS INTERSECTES
  1007. * ET D(M,PT_REMONTE) SINON
  1008.  
  1009.  
  1010. * S_OMBRE2 contient les noeuds de s_ombre qui n'ont
  1011. * pas ete intesectes.
  1012. s_ombre2 = diff s_ombre2 MINTER ;
  1013.  
  1014. * actualisation du maillage de remontee
  1015. mailcou = s_ombre2 et mailpts ;
  1016.  
  1017. CHSIGN1 = REDU CHSIGN1 mailcou ;
  1018.  
  1019. SI ((NBNO MINTER) > 0) ;
  1020. mess 'nombre de noeuds intersectes ' (NBNO MINTER) ;
  1021. LMAX1 = LCOURAN1 - pasb0 + (mini CHDIST9) ;
  1022. FINSI ;
  1023.  
  1024. * --- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  1025. chdist = chdist + CHDIST9 ;
  1026. mess 'mini maxi dist connection en m' (mini (prog lmax1 (mini chdist))) lmax1 ;
  1027.  
  1028.  
  1029. finsi ;
  1030. * ------------------ fin du test d'interception ------------------
  1031.  
  1032.  
  1033.  
  1034. *-----------------------------------------------------------------
  1035. *--- construction des lignes de champ remontees
  1036. *--- Extraction des coordonnees des points a remonter
  1037. xmailpt1 = redu XG_NEW mailpts ;
  1038. ymailpt1 = redu YG_NEW mailpts ;
  1039. zmailpt1 = redu ZG_NEW mailpts ;
  1040.  
  1041. *--- Calcul des coordonnees des points a remonter dans le repere du maillage
  1042. xmailpt2 = xmailpt1 ;
  1043. ymailpt2 = ymailpt1 ;
  1044. zmailpt2 = zmailpt1 ;
  1045.  
  1046. *--- Construction des lignes de remontee
  1047. repeter boupts3 npts ;
  1048. xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts3) ;
  1049. yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts3) ;
  1050. zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts3) ;
  1051. prem2 = xprem2 yprem2 zprem2 ;
  1052. tablig1 . &boupts3 = (tablig1 . &boupts3) d 1 prem2 ;
  1053. fin boupts3 ;
  1054. *-----------------------------------------------------------------
  1055.  
  1056.  
  1057.  
  1058. * --- actualisation des champs de coordonnees pour iteration suivante
  1059.  
  1060. XG_OLD = redu XG_NEW mailcou;
  1061. YG_OLD = redu YG_NEW mailcou;
  1062. ZG_OLD = redu ZG_NEW mailcou;
  1063.  
  1064. MENA ;
  1065. FORM DEP0 ;
  1066. TAB1.<DEPLACE = TAB1.<DEPLACE + DEP0 ;
  1067. TITRE 'AVEC TEST, ITERATION : 'I1 ;
  1068. TRAC ((s_ombre2 coul roug) ET MINTER ET TAB1.<GRILLE_B ET TAB1.<S_OMBRANT) ;
  1069.  
  1070. FIN BOUCLE2 ;
  1071. * --------------------- Fin de la boucle 2 ----------------------
  1072.  
  1073.  
  1074. *--- Sorties dans TAB1
  1075.  
  1076. TAB1.<CHDIST = CHDIST ;
  1077. TAB1.<CONNEXION_MAX = LMAX1 ;
  1078. TAB1.<LONGUEUR_REMONTEE = LCOURAN1 ;
  1079.  
  1080. si (exis tab1 <remontee) ;
  1081. tab1 . <remontee . <ligne = tablig1 ;
  1082. finsi ;
  1083.  
  1084. *Sauvegardes pour reprise eventuelle
  1085. XG_OLD = nomc X XG_OLD nature discret ;
  1086. YG_OLD = nomc Y YG_OLD nature discret ;
  1087. ZG_OLD = nomc Z ZG_OLD nature discret ;
  1088. tab1.<CHCOOR0 = (XG_OLD et YG_OLD et ZG_OLD) ;
  1089. tab1.<s_omb_non_inter = s_ombre2 ;
  1090. tab1.<i_ombrage = i1 ;
  1091.  
  1092. MESS '---------------------------------> exiting @ANAJET';
  1093. FINPROC ;
  1094.  
  1095. **** @ANALY
  1096.  
  1097. DEBPROC @ANALY TAB1*TABLE ;
  1098.  
  1099. MESS '---------------------------------> calling @ANALY';
  1100. MESS 'METHODE ANALYTIQUE' ;
  1101. *
  1102. *--------------- VARIABLES D'ENTREE :
  1103. *
  1104.  
  1105. S_OMBRE = TAB1.<S_OMBRE ;
  1106. S_OMBRAN = TAB1.<S_OMBRANT ;
  1107. IMETHOD = TAB1.<METHODE_REMONTEE ;
  1108. CHSIGN1 = TAB1.<CHSIGN ;
  1109.  
  1110. TYPCAL = TAB1.<TYPE_CALCUL ;
  1111. RP = TAB1.<RP ;
  1112. RHO0 = TAB1.<RHO0 ;
  1113. RR = TAB1.<RR ;
  1114. HP = TAB1.<HP ;
  1115. EPS0 = TAB1.<EPS ;
  1116. COEFA = TAB1.<COEFA ;
  1117. COEFB = TAB1.<COEFB ;
  1118. COEFC = TAB1.<COEFC ;
  1119. NBOB = TAB1.<NBOB ;
  1120.  
  1121. si (exis tab1 <remontee) ;
  1122. TABPTS1 = TAB1.<REMONTEE.<POINT ;
  1123. tablig1 = table ;
  1124. finsi ;
  1125.  
  1126. PASB2 = TAB1.<PAS_AVEC_TEST ;
  1127. DMAX2 = TAB1.<DIST_AVEC_TEST ;
  1128. NBPAS2 = TAB1.<NBPAS2 ;
  1129.  
  1130. SI (EXIS TAB1 <PAS_SANS_TEST) ;
  1131. PASB1 = TAB1.<PAS_SANS_TEST ;
  1132. DMAX1 = TAB1.<DIST_SANS_TEST ;
  1133. NBPAS1 = TAB1.<NBPAS1 ;
  1134. FINSI ;
  1135.  
  1136.  
  1137. SI (EXIS TAB1 <TOLERANCE) ;
  1138. TOL1 = TAB1.<TOLERANCE ;
  1139. SINON ;
  1140. TOL1 = 1.e-9 ;
  1141. FINSI ;
  1142.  
  1143. *
  1144. * --- PASSAGE EN TRI3 POUR LA PROC @INTERC
  1145. *
  1146.  
  1147. LMOT = s_ombran ELEM 'TYPE' ;
  1148. ntyp = dime LMOT ;
  1149. si (ntyp ega 2) ;
  1150. stri3 = elem s_ombran tri3 ;
  1151. squa4 = elem s_ombran qua4 ;
  1152. squtri3 = chan squa4 tri3 ;
  1153. s_ombra2 = squtri3 et stri3 ;
  1154. sinon ;
  1155. s_ombra2 = chan s_ombran tri3 ;
  1156. finsi ;
  1157.  
  1158. *
  1159. * ---
  1160. *
  1161. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  1162. ISHIFT = VRAI ;
  1163. IRIPPLE = VRAI ;
  1164. FINSI ;
  1165. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  1166. ISHIFT = VRAI ;
  1167. IRIPPLE = FAUX ;
  1168. FINSI ;
  1169. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  1170. ISHIFT = FAUX ;
  1171. IRIPPLE = VRAI ;
  1172. FINSI ;
  1173. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  1174. ISHIFT = FAUX ;
  1175. IRIPPLE = FAUX ;
  1176. FINSI ;
  1177. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  1178. ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
  1179. FINSI ;
  1180.  
  1181.  
  1182. * --- CONSTRUCTION DU MAILLAGE DES POINTS A REMONTER
  1183. si (exis tab1 <remontee) ;
  1184. MAILPTS = MANU POI1 TABPTS1 . 1 ;
  1185. NPTS = DIME TABPTS1 ;
  1186. REPETER BOUPTS1 (NPTS - 1) ;
  1187. MAILPTS = MAILPTS ET TABPTS1 . (&BOUPTS1 + 1) ;
  1188. FIN BOUPTS1 ;
  1189. sinon ;
  1190. * RM 15/06/2000 MAILPTS = MANU POI1 (s_ombre poin init) ;
  1191. MAILPTS = MANU POI1 ((chan s_ombre poi1) poin init) ;
  1192. TABPTS1 = table ;
  1193. TABPTS1 . 1 = (chan s_ombre poi1) poin init ;
  1194. npts = 1 ;
  1195. tablig1 = table ;
  1196. finsi ;
  1197.  
  1198.  
  1199. si (non (tab1.<reprise)) ;
  1200. * --- CREATION DES 3 CHMELEM DE COORDONNEES AUX ELEMENTS
  1201. * --- Remarque : ces coordonnees seront exprimees dans le repere globale
  1202. TAB1.<MAILLAGE = S_OMBRA2 ;
  1203. si (non (exis tab1 <chamx1)) ;
  1204. @RMCOORO TAB1 ;
  1205. finsi ;
  1206. * --- CALCUL DES NORMALES AUX ELEMENTS SUR LE MAILLAGE OMBRANT
  1207. si (non (exis tab1 <cosx)) ;
  1208. @RMNORM TAB1 ;
  1209. finsi ;
  1210. finsi ;
  1211.  
  1212.  
  1213. *
  1214. * --- Rappel des parametres de la procedure
  1215. *
  1216. MESS ' ';
  1217. MESS '##################################################';
  1218. MESS ' ';
  1219. MESS '>@ANALY> procedure OMBRAGE, Rappel des parametres de calcul ';
  1220. MESS ' ';
  1221.  
  1222. si (tab1.<reprise) ;
  1223. mess 'Reprise d un calcul';
  1224. mess '-------------------';
  1225. finsi ;
  1226.  
  1227. SI (IMETHOD EGA 1) ;
  1228. METH = 'methode explicite des tangentes';
  1229. FINSI ;
  1230. SI (IMETHOD EGA 2) ;
  1231. METH = 'methode moyenne des tangentes aux extremitee';
  1232. FINSI ;
  1233. SI (IMETHOD EGA 3) ;
  1234. METH = 'methode du point milieu';
  1235. FINSI ;
  1236. SI (IMETHOD EGA 4) ;
  1237. METH = 'methode de reprojection';
  1238. FINSI ;
  1239. MESS ' ';
  1240.  
  1241. SI (EXIS tab1 <PAS_SANS_TEST) ;
  1242. MESS 'Calcul en deux parties :';
  1243. MESS ' ';
  1244. MESS 'SANS TEST';
  1245. MESS 'Distance remontee :' DMAX1 ;
  1246. MESS 'Pas pour la remontee :' PASB1 ;
  1247. MESS 'Nombre d iterations :' NBPAS1 ;
  1248. MESS ' ';
  1249. MESS 'AVEC TEST';
  1250. MESS 'Distance remontee :' DMAX2 ;
  1251. MESS 'Pas pour la remontee :' PASB2 ;
  1252. MESS 'Nombre d iterations :' NBPAS2 ;
  1253. SINON ;
  1254. MESS 'Calcul avec test systematique :';
  1255. MESS 'Distance remontee :' DMAX2 ;
  1256. MESS 'Pas de remontee :' PASB2 ;
  1257. MESS 'Nombre d iterations :' NBPAS2 ;
  1258. FINSI ;
  1259. MESS ' ' ;
  1260.  
  1261. SI ISHIFT ;
  1262. MESS 'Calcul avec shift de Safranov' ;
  1263. SINON ;
  1264. MESS 'Calcul sans shift de Safranov';
  1265. FINSI ;
  1266.  
  1267. SI IRIPPLE ;
  1268. MESS 'Calcul avec ripple du champ toroidal' ;
  1269. SINON ;
  1270. MESS 'Calcul sans ripple du champ toroidal' ;
  1271. FINSI ;
  1272.  
  1273.  
  1274. *
  1275. *--------------------------------------------------------------
  1276. *
  1277. * INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  1278. * --- CAS SANS REPRISE ---
  1279. *--------------------------------------------------------------
  1280. si (non (tab1.<reprise)) ;
  1281. * --- initialisation du pas
  1282. I1 = 0 ;
  1283. * ---initialisation de la distance de connexion
  1284. CHDIST = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
  1285. * --- initialisation du maillage ou on va tester les intersections
  1286. s_ombre2 = s_ombre ;
  1287. * --- initialisation du maillage ou on va remonter les lignes
  1288. mailcou = s_ombre2 et mailpts ;
  1289. *---- initialisation des distances
  1290. LCOURAN1 = 0. ;
  1291. LMAX1 = 0. ;
  1292. * ---- coordonnees dans le repere du maillage
  1293. XM0 = COOR 1 mailcou ;
  1294. YM0 = COOR 2 mailcou ;
  1295. ZM0 = COOR 3 mailcou ;
  1296. *---- Coordonnees dans le repere global du tore
  1297. XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
  1298. *
  1299. * --- initialisation des lignes de champ remontees
  1300. REPETER BOUPTS1 NPTS ;
  1301. tablig1 . &BOUPTS1 = TABPTS1 . &BOUPTS1 ;
  1302. FIN BOUPTS1 ;
  1303.  
  1304. sinon ;
  1305. *
  1306. *--------------------------------------------------------------
  1307. *
  1308. * INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  1309. * --- CAS AVEC REPRISE ---
  1310. *--------------------------------------------------------------
  1311. * --- initialisation du pas
  1312. I1 = tab1.<i_ombrage ;
  1313. * --- initialisation de la distance de connexion
  1314. CHDIST = tab1.<chdist;
  1315. * --- initialisation du maillage ou on va tester les intersections
  1316. s_ombre2 = tab1.<s_omb_non_inter ;
  1317. * --- initialisation du maillage ou on va remonter les lignes
  1318. mailcou = s_ombre2 et mailpts ;
  1319.  
  1320.  
  1321. *---- initialisation des distances
  1322. LCOURAN1 = maxi chdist ;
  1323. LMAX1 = tab1.<CONNEXION_MAX ;
  1324.  
  1325. *---- Coordonnees dans le repere global du tore
  1326. XG_OLD = exco X tab1.<CHCOOR0 ;
  1327. YG_OLD = exco Y tab1.<CHCOOR0 ;
  1328. ZG_OLD = exco Z tab1.<CHCOOR0 ;
  1329. *
  1330.  
  1331. * --- initialisation des lignes de champ remontees
  1332. si (exis tab1 <remontee) ;
  1333. tablig1 = tab1.<remontee.<ligne ;
  1334. sinon ;
  1335. tablig1 . 1 = (TABPTS1 . 1) d 1 (TABPTS1.1 plus (0. 0. 0.));
  1336. finsi ;
  1337.  
  1338. finsi ;
  1339.  
  1340. *--------------------------------------------------------------
  1341. *
  1342. * DEBUT DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  1343. *
  1344. *--------------------------------------------------------------
  1345. *
  1346. MESS ' ';
  1347. MESS '##################################################';
  1348. MESS ' ';
  1349.  
  1350. SI (EXIS TAB1 <DIST_SANS_TEST) ;
  1351.  
  1352. * ------------------ Boucle 1 on remonte sans test -------------------
  1353. PASB0 = PASB1 ;
  1354. * increment de la distance de connexion (= PAS tant qu'il n'y a pas
  1355. * d'intersection)
  1356. chdist9 = manu chpo s_ombre2 1 scal pasb0 ;
  1357.  
  1358. MESS 'PREMIERE PARTIE DU CALCUL, SANS TEST D INTERSECTION';
  1359. REPETER BOUCLE1 NBPAS1 ;
  1360. I1 = I1 + 1 ;
  1361. LCOURAN1 = LCOURAN1 + PASB0 ;
  1362. MESS ' ';
  1363. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  1364.  
  1365. * ---- Appel de la procedure de remontee des lignes de champ
  1366. XG_NEW YG_NEW ZG_NEW = @remonte XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1 ;
  1367.  
  1368. *--- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  1369. chdist = chdist + CHDIST9 ;
  1370.  
  1371.  
  1372. *-----------------------------------------------------------------
  1373. *--- construction des lignes de champ remontees
  1374. * --- Extraction des coordonnees des points a remonter
  1375. xmailpt1 = redu XG_NEW mailpts ;
  1376. ymailpt1 = redu YG_NEW mailpts ;
  1377. zmailpt1 = redu ZG_NEW mailpts ;
  1378.  
  1379. * --- Calcul des coordonnees des points a remonter dans le repere du maillage
  1380. xmailpt2 ymailpt2 zmailpt2 = @crgmc xmailpt1 ymailpt1 zmailpt1 tab1 ;
  1381. *
  1382. * --- Construction des lignes de remontee
  1383. repeter boupts2 npts ;
  1384. xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts2) ;
  1385. yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts2) ;
  1386. zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts2) ;
  1387. prem2 = xprem2 yprem2 zprem2 ;
  1388. tablig1.&boupts2 = (tablig1 . &boupts2) d 1 prem2 ;
  1389. fin boupts2 ;
  1390. **-----------------------------------------------------------------
  1391.  
  1392.  
  1393. * --- actualisation des champs de coordonnees pour iteration suivante
  1394.  
  1395. XG_OLD = XG_NEW ;
  1396. YG_OLD = YG_NEW ;
  1397. ZG_OLD = ZG_NEW ;
  1398.  
  1399. MENA ;
  1400.  
  1401. FIN BOUCLE1 ;
  1402. * ------------------------ Fin de la boucle 1 ------------------------
  1403. finsi ;
  1404.  
  1405.  
  1406. MESS ' ';
  1407. MESS '##################################################';
  1408. MESS ' ';
  1409.  
  1410. MESS 'CALCUL AVEC TEST D INTERSECTION';
  1411.  
  1412. * ------------------ Boucle 2 on remonte avec test -------------------
  1413. PASB0 = PASB2 ;
  1414. si (non (tab1.<reprise)) ;
  1415. s_ombre2 = chan s_ombre poi1 ;
  1416. mailcou = s_ombre2 et mailpts ;
  1417. finsi ;
  1418. REPETER BOUCLE2 NBPAS2 ;
  1419.  
  1420. I1 = I1 + 1 ;
  1421. LCOURAN1 = LCOURAN1 + PASB0 ;
  1422. MESS ' ';
  1423. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  1424.  
  1425. * ---- Appel de la procedure de remonter des lignes de champ
  1426. XG_NEW YG_NEW ZG_NEW = @remonte XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1 ;
  1427. *---- ------test sur les eventuels noeuds interceptes -----------
  1428. *---- seulement s'il reste des noeuds non encore intersectes ----
  1429. si (nbno s_ombre2 > 0.) ;
  1430.  
  1431. * --- Les CHPO sont reduits sur les points de s_ombre
  1432. * --- qui n'ont pas encore ete intersectes : s_ombre2
  1433.  
  1434. XG_OLD_R = REDU XG_OLD S_OMBRE2 ;
  1435. YG_OLD_R = REDU YG_OLD S_OMBRE2 ;
  1436. ZG_OLD_R = REDU ZG_OLD S_OMBRE2 ;
  1437.  
  1438. XG_NEW_R = REDU XG_NEW S_OMBRE2 ;
  1439. YG_NEW_R = REDU YG_NEW S_OMBRE2 ;
  1440. ZG_NEW_R = REDU ZG_NEW S_OMBRE2 ;
  1441.  
  1442.  
  1443. XG_OLD_R = NOMC X XG_OLD_R 'NATU' 'DIFFUS' ;
  1444. YG_OLD_R = NOMC Y YG_OLD_R 'NATU' 'DIFFUS' ;
  1445. ZG_OLD_R = NOMC Z ZG_OLD_R 'NATU' 'DIFFUS' ;
  1446.  
  1447. CH_OLD = XG_OLD_R ET YG_OLD_R ET ZG_OLD_R ;
  1448.  
  1449.  
  1450. XG_NEW_R = NOMC X XG_NEW_R 'NATU' 'DIFFUS' ;
  1451. YG_NEW_R = NOMC Y YG_NEW_R 'NATU' 'DIFFUS' ;
  1452. ZG_NEW_R = NOMC Z ZG_NEW_R 'NATU' 'DIFFUS' ;
  1453.  
  1454. CH_NEW = XG_NEW_R ET YG_NEW_R ET ZG_NEW_R ;
  1455.  
  1456. *
  1457. * --- APPEL DE LA PROCEDURE DE CALCUL DES NOEUDS INTERSECTES
  1458. *
  1459. * CHDIST9 MINTER = @INTERC CH_OLD CH_NEW TOL1 TAB1 ;
  1460. CHDIST9 MINTER = ITRC CH_OLD CH_NEW TOL1 TAB1 ;
  1461.  
  1462. * CHDIST9 = CHPO CONTENANT PAS POUR LES NOEUDS INTERSECTES
  1463. * ET D(M,PT_REMONTE) SINON
  1464.  
  1465.  
  1466. * S_OMBRE2 contient les noeuds de s_ombre qui n'ont
  1467. * pas ete intesectes.
  1468. s_ombre2 = diff s_ombre2 MINTER ;
  1469.  
  1470. * actualisation du maillage de remontee
  1471. mailcou = s_ombre2 et mailpts ;
  1472.  
  1473. CHSIGN1 = REDU CHSIGN1 mailcou ;
  1474.  
  1475. SI ((NBNO MINTER) > 0) ;
  1476. mess 'nombre de noeuds intersectes ' (NBNO MINTER) ;
  1477. LMAX1 = LCOURAN1 - pasb0 + (mini CHDIST9) ;
  1478. FINSI ;
  1479.  
  1480. * --- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  1481. chdist = chdist + CHDIST9 ;
  1482. mess 'mini maxi dist connection en m' (mini (prog lmax1 (mini chdist))) lmax1 ;
  1483.  
  1484.  
  1485. finsi ;
  1486. * ------------------ fin du test d'interception ------------------
  1487.  
  1488.  
  1489.  
  1490. *-----------------------------------------------------------------
  1491. *--- construction des lignes de champ remontees
  1492. *--- Extraction des coordonnees des points a remonter
  1493. xmailpt1 = redu XG_NEW mailpts ;
  1494. ymailpt1 = redu YG_NEW mailpts ;
  1495. zmailpt1 = redu ZG_NEW mailpts ;
  1496.  
  1497. *--- Calcul des coordonnees des points a remonter dans le repere du maillage
  1498. xmailpt2 ymailpt2 zmailpt2 = @crgmc xmailpt1 ymailpt1 zmailpt1 tab1 ;
  1499.  
  1500. *--- Construction des lignes de remontee
  1501. repeter boupts3 npts ;
  1502. xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts3) ;
  1503. yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts3) ;
  1504. zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts3) ;
  1505. prem2 = xprem2 yprem2 zprem2 ;
  1506. tablig1 . &boupts3 = (tablig1 . &boupts3) d 1 prem2 ;
  1507. fin boupts3 ;
  1508. *-----------------------------------------------------------------
  1509.  
  1510.  
  1511.  
  1512. * --- actualisation des champs de coordonnees pour iteration suivante
  1513.  
  1514. XG_OLD = redu XG_NEW mailcou;
  1515. YG_OLD = redu YG_NEW mailcou;
  1516. ZG_OLD = redu ZG_NEW mailcou;
  1517.  
  1518. MENA ;
  1519.  
  1520. FIN BOUCLE2 ;
  1521. * --------------------- Fin de la boucle 2 ----------------------
  1522.  
  1523.  
  1524. *--- Sorties dans TAB1
  1525.  
  1526. TAB1.<CHDIST = CHDIST ;
  1527. TAB1.<CONNEXION_MAX = LMAX1 ;
  1528. TAB1.<LONGUEUR_REMONTEE = LCOURAN1 ;
  1529.  
  1530. si (exis tab1 <remontee) ;
  1531. tab1 . <remontee . <ligne = tablig1 ;
  1532. finsi ;
  1533.  
  1534. *Sauvegardes pour reprise eventuelle
  1535. XG_OLD = nomc X XG_OLD nature discret ;
  1536. YG_OLD = nomc Y YG_OLD nature discret ;
  1537. ZG_OLD = nomc Z ZG_OLD nature discret ;
  1538. tab1.<CHCOOR0 = (XG_OLD et YG_OLD et ZG_OLD) ;
  1539. tab1.<s_omb_non_inter = s_ombre2 ;
  1540. tab1.<i_ombrage = i1 ;
  1541.  
  1542. MESS '---------------------------------> exiting @ANALY';
  1543. FINPROC ;
  1544.  
  1545. **** @ARANGU
  1546. DEBPROC @ARANGU T1*FLOTTANT V1*FLOTTANT E1*FLOTTANT ;
  1547. *-------------------------------------------------------------------*
  1548. * R. Mitteau
  1549. * Fatigue du cuivre OFHC
  1550. *
  1551. * D'apres la publi
  1552. *
  1553. *
  1554. * High Temperature Torsional Low Cycle Fatigue of OFHC Copper
  1555. * Ahmet Aran and Dogan Erdun Gucer, Material Research Division,
  1556. * Marmara Research Institute...
  1557. *
  1558. * in Z. Metallkunde
  1559. * T1 temperature en degres K
  1560. * V1 vitesse de deformation en s-1
  1561. * E1 Deformation en .
  1562. *
  1563. *
  1564. *23456789012345678901234567890123456789012345678901234567890123456789012
  1565. * 1 2 3 4 5 6 7
  1566. *-------------------------------------------------------------------*
  1567. MESS '-----------------------------------------------> calling @ARANGU';
  1568. *
  1569. * --- donnees
  1570. *
  1571. * Temperature de la matiere en Kelvin
  1572. TLIEU1 = T1 ;
  1573. * Variation equivalente de la deformation au lieu considere
  1574. EPSETOI1 = E1 ;
  1575. * Vitesse de deformation
  1576. VDEF1 = V1 ;
  1577.  
  1578. *
  1579. * --- Calcul du alpha de la loi de Mansson-Coffin
  1580. *
  1581. EVALPH1 = EVOL MANU 'T' (PROG 293 438 588 668 ) 'ALPH' (PROG .67 .71 .63 .50 );
  1582. EVALPH2 = EVOL MANU 'T' (PROG 293 438 588 668 ) 'ALPH' (PROG .64 .79 .69 .50 );
  1583.  
  1584. VALALPH1 = IPOE EVALPH1 TLIEU1 FIXE;
  1585. VALALPH2 = IPOE EVALPH2 TLIEU1 FIXE;
  1586.  
  1587. EVALPH3 = EVOL MANU 'VDEF' (PROG 1.81E-3 9.05E-3 ) 'ALPH' (PROG VALALPH1 VALALPH2);
  1588.  
  1589. ALPHA1 = IPOE VDEF1 EVALPH3 LINE;
  1590.  
  1591.  
  1592.  
  1593. *
  1594. * --- Calcul du C de la loi de Mansson-Coffin
  1595. *
  1596. EVC1 = EVOL MANU 'T' (PROG 293 438 588 668 ) 'C' (PROG 5.77 6.3 3.56 0.72 );
  1597. EVC2 = EVOL MANU 'T' (PROG 293 438 588 668 ) 'C' (PROG 5.03 12.25 7.01 1.09 );
  1598.  
  1599. VALC1 = IPOE EVC1 TLIEU1 FIXE;
  1600. VALC2 = IPOE EVC2 TLIEU1 FIXE;
  1601.  
  1602. EVC3 = EVOL MANU 'VDEF' (PROG 1.81E-3 9.05E-3 ) 'C' (PROG VALC1 VALC2);
  1603.  
  1604. CA1 = IPOE VDEF1 EVC3 LINE;
  1605.  
  1606.  
  1607. *
  1608. * --- Calcul du nombre de cycles
  1609. *
  1610.  
  1611. NCYCLES1 = (CA1/EPSETOI1) ** (1. / ALPHA1) ;
  1612. NCYCLES2 = ENTI (NCYCLES1 + 1);
  1613. MESS '>@ARANGU> Temperature [K] : ' T1 ;
  1614. MESS '>@ARANGU> Deformation speed [S-1] : ' V1 ;
  1615. MESS '>@ARANGU> Rupture according to Aran-Gucer [cycles]: ' NCYCLES2 ;
  1616.  
  1617. MESS '-----------------------------------------------> exiting @ARANGU';
  1618. FINPROC NCYCLES1;
  1619.  
  1620. **** @BOWRI72
  1621. DEBPROC @BOWRI72 TAB_1*TABLE ;
  1622. *
  1623. *
  1624. * CALCUL DU FLUX CRITIQUE SUIVANT LA CORRELATION DE BOWRING
  1625. *23456789012345678901234567890123456789012345678901234567890123456789012
  1626. * 1 2 3 4 5 6 7
  1627. *
  1628. * --- entrees
  1629. *
  1630. INIVEAU1 = TAB_1.'NIVEAU' ;
  1631. D_DIAM1 = TAB_1.'D_DIAM' ;
  1632. L_LONG1 = TAB_1.'L_HEATED' ;
  1633. P_PRES1 = TAB_1.'P_IN' ;
  1634. V_VITE1 = TAB_1.'V_IN' ;
  1635. T_TEMP1 = TAB_1.'T_IN' ;
  1636. TEST1 = FAUX ;
  1637. SI (EXISTE TAB1 ANNULE_D_DEF);
  1638. SI TAB1.ANNULE_D_DEF ;
  1639. TEST1 = VRAI;
  1640. FINSI ;
  1641. FINSI ;
  1642.  
  1643. *
  1644. * --- racine
  1645. *
  1646. SI (INIVEAU1 >EG 2 ) ;
  1647. MESS '---------------------------------> calling @BOWRI72';
  1648. FINSI ;
  1649. PI = 3.14159;
  1650. LOGI_1 = EXISTE TAB_1 EPTSAT;
  1651. LOGI_2 = EXISTE TAB_1 ETHFG;
  1652. LOGI_3 = EXISTE TAB_1 ETRHOF;
  1653. LOGI_4 = EXISTE TAB_1 ETCPF;
  1654. SI (NON (LOGI_1 ET LOGI_2 ET LOGI_3 ET LOGI_4));
  1655. @TABEAU TAB_1 ;
  1656. FINSI ;
  1657.  
  1658. *
  1659. * --- Test du domaine de definition des entrees
  1660. *
  1661. G_VITE1 = V_VITE1 * (@IPOE TAB_1.ETRHOF T_TEMP1);
  1662.  
  1663. SI TEST1 ;
  1664. * - test sur la vitesse de l'eau
  1665. SI ((G_VITE1 < 136.) OU ( G_VITE1 > 18600.)) ;
  1666. MESS 'Vitesse massique : ' G_VITE1;
  1667. ERRE '@BOWRING -> Vitesse massique hors [136. , 18600.] (Kg/M2/S)';
  1668. FINSI ;
  1669.  
  1670. * - test sur le diametre
  1671. SI ((D_DIAM1 < 2.E-3) OU (D_DIAM1 > 450.E-3)) ;
  1672. MESS 'Diametre : ' D_DIAM1;
  1673. ERRE '@BOWRING -> Diametre hors [0.002 0.45] (M)' ;
  1674. FINSI ;
  1675.  
  1676. * - test sur la Pression
  1677. SI ((P_PRES1 < 1.E5) OU (P_PRES1 > 200.E5)) ;
  1678. MESS 'Pression : ' P_PRES1;
  1679. ERRE '@BOWRING -> Pression hors de [1.E5, 200.E5] (Pa) ' ;
  1680. FINSI ;
  1681.  
  1682. * - test sur la longueur chauffee
  1683. SI ((L_LONG1 < 0.15) OU (L_LONG1 > 3.7)) ;
  1684. MESS 'Longueur : ' L_LONG1;
  1685. ERRE '@BOWRING --> Longueur hors de [0.15,3.7](M) ' ;
  1686. FINSI ;
  1687.  
  1688. * Fin des tests sur les entrees de @BOWRI72
  1689. FINSI ;
  1690.  
  1691. T_SAT = @IPOE TAB_1.EPTSAT P_PRES1 ;
  1692.  
  1693. P1 = P_PRES1 / 6900000. ;
  1694. SI (INIVEAU1 >EG 2) ;
  1695. MESS 'P_PRIME : ' P1 ;
  1696. FINSI ;
  1697.  
  1698. SI (P1 &lt;EG 1.) ;
  1699. F1 = (((P1 ** 18.942) * (EXP (20.8 * (1. - P1)))) + 0.917) / 1.917;
  1700. F2 = (F1 * 1.309)/(((P1 ** 1.316)*(EXP(2.444*(1. - P1)))) + 0.309);
  1701. F3 = (((P1 ** 17.023)*(EXP(16.658*(1. - P1)))) + 0.667)/1.667;
  1702. F4 = F3 * (P1 ** 1.649) ;
  1703. SINON ;
  1704. F1 = (P1 ** (-0.368))*(EXP(0.648*(1. - P1)));
  1705. F2 = (P1 ** (-0.448))*(EXP(0.245*(1. - P1)));
  1706. F3 = P1 ** 0.219;
  1707. F4 = F3 * (P1 ** 1.649) ;
  1708. FINSI ;
  1709.  
  1710. SI (INIVEAU1 >EG 2) ;
  1711. MESS 'F1 : ' F1 ;
  1712. MESS 'F2 : ' F2 ;
  1713. MESS 'F3 : ' F3 ;
  1714. MESS 'F4 : ' F4 ;
  1715. FINSI ;
  1716.  
  1717.  
  1718. L_VAP = @IPOE TAB_1.ETHFG T_TEMP1 ;
  1719. CP__1 = @IPOE TAB_1.ETCPF T_TEMP1 ;
  1720.  
  1721. S_SAT = CP__1 * (T_SAT - T_TEMP1) ;
  1722.  
  1723. SI (INIVEAU1 >EG 2) ;
  1724. MESS 'L_VAP : ' L_VAP ;
  1725. MESS 'CP__1 : ' CP__1 ;
  1726. MESS 'S_SAT : ' S_SAT ;
  1727. FINSI ;
  1728.  
  1729. A__1 = 0.5793 * L_VAP * D_DIAM1 * G_VITE1 * F1 / (1. + (0.0143 * F2 * (D_DIAM1 ** .5) * G_VITE1 )) ;
  1730.  
  1731. B__1 = .25 * D_DIAM1 * G_VITE1 ;
  1732.  
  1733. C__1 = 0.077 * D_DIAM1 * G_VITE1 * F3 / (1. + (0.347 * F4 * ((G_VITE1/1356.) ** (2. - (.5 * P1))))) ;
  1734.  
  1735. SI (INIVEAU1 >EG 5) ;
  1736. MESS 'A : ' A__1 ;
  1737. MESS 'B : ' B__1 ;
  1738. MESS 'C : ' C__1 ;
  1739. FINSI ;
  1740.  
  1741. QCHFW = (A__1 + (B__1 * S_SAT)) / (C__1 + L_LONG1) ;
  1742.  
  1743. G1 = G_VITE1 * PI * D_DIAM1 * D_DIAM1 / 4. ;
  1744. *
  1745. * --- sortie de la procedure
  1746. *
  1747.  
  1748. SI ( INIVEAU1 >EG 1 ) ;
  1749. MESS '>>@BOWRI72>> TUBE DIAMETER (M) : ' D_DIAM1 ;
  1750. MESS '>>@BOWRI72>> TUBE LENGHT (M) : ' L_LONG1 ;
  1751. MESS '>>@BOWRI72>> MASS FLOW VELOCITY (KG/S/M2) : ' G_VITE1;
  1752. MESS '>>@BOWRI72>> INLET MASS FLOW RATE (KG/S) : ' G1 ;
  1753. MESS '>>@BOWRI72>> VELOCITY (M/S) : ' V_VITE1 ;
  1754. MESS '>>@BOWRI72>> FLUID INLET TEMPERATURE (C) : ' T_TEMP1 ;
  1755. MESS '>>@BOWRI72>> FLUID INLET PRESSURE (PA) : ' P_PRES1 ;
  1756. MESS '>>@BOWRI72>> WATER SATURATION TEMPERATURE(C) : ' T_SAT ;
  1757. MESS '>>@BOWRI72>> WALL CRITICAL HEAT FLUX (W/m2) : ' QCHFW ;
  1758. FINSI ;
  1759.  
  1760. SI (INIVEAU1 >EG 2 ) ;
  1761. MESS '---------------------------------> Sortie de @BOWRI72';
  1762. FINSI ;
  1763. *
  1764. * --- sorties
  1765. *
  1766. TAB1.CHF = QCHFW ;
  1767.  
  1768. FINPROC ;
  1769.  
  1770.  
  1771. debproc @calcflu mod1*mmodel cht1*chpoint mat1*chpoint ;
  1772.  
  1773. gradt1 = grad cht1 mod1 ;
  1774. flux1 = mat1 * gradt1 ;
  1775.  
  1776. finproc flux1 ;
  1777.  
  1778. **** @CALHCON
  1779. DEBPROC @CALHCON TAB_1*TABLE ;
  1780.  
  1781. *
  1782. * !!! R. MITTEAU !!! attention, procedure standard
  1783. *
  1784. * un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
  1785. * pour les mises a jour
  1786. *
  1787. *-------------------------------------------------------------------*
  1788. * *
  1789. * COEFFICIENT D ECHANGE TENANT COMPTE *
  1790. * DE L EBULLITION SOUS SATUREE *
  1791. * *
  1792. *-------------------------------------------------------------------*
  1793. *
  1794. DIAM = TAB_1 . D_MAQUETTE ;
  1795. TTAPE = TAB_1 . T_TAPE ;
  1796. YTW1 = TAB_1 . TWIST_RATIO ;
  1797. V1 = TAB_1 . V_LOCAL ;
  1798. *js 20/4/95 je change T_MOY en t_local ????
  1799. T_LOC1 = TAB_1 . 'T_LOCAL' ;
  1800. NIVEAU = TAB_1.'NIVEAU' ;
  1801. P_LOCAL1 = TAB_1.'P_LOCAL' ;
  1802. L1TRAC = TAB_1.'TRAC_GRAPHE' ;
  1803. *
  1804. SI (NIVEAU >EG 4) ;
  1805. MESS '-----------------------------------> calling @CALHCON ' ;
  1806. FINSI ;
  1807. *
  1808. *
  1809. PI = 3.14159 ;
  1810. *S1 = PI * DIAM * DIAM / 4. ;
  1811. SI ( NON ( EXISTE TAB_1 HYPERVAP ) ) ;
  1812. TAB_1.HYPERVAP = FAUX ;
  1813. FINSI ;
  1814. SI ( ( YTW1 EGA 0. 1.E-6 ) ET ( EGA TAB_1.HYPERVAP FAUX ) ) ;
  1815. S1 = PI * DIAM * DIAM / 4. ;
  1816. TAB_1.DH = DIAM ;
  1817. FACV = 1. ;
  1818. FACF = 1. ;
  1819. FINSI ;
  1820. SI ( NON ( EXISTE TAB_1 HELI_WIRE ) ) ;
  1821. TAB_1.HELI_WIRE = FAUX ;
  1822. FINSI ;
  1823. SI ( ( YTW1 EGA 0. 1.E-6 ) ET ( EGA TAB_1.HELI_WIRE VRAI ) ET ( EGA TAB_1.HYPERVAP FAUX ) ) ;
  1824. S1 = PI * DIAM * DIAM / 4. ;
  1825. SM = PI * TAB_1.WIRE_D * TAB_1.WIRE_D / 4. ;
  1826. P1 = PI * DIAM ;
  1827. PM = PI * TAB_1.WIRE_D ;
  1828. TAB_1.DH = 4. * ( S1 - SM ) / ( P1 + PM ) ;
  1829. PIS2Y = PI / ( 2 * TAB_1.PITCH_WIRE ) ;
  1830. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  1831. * FACV = 1. ;
  1832. FACF = 1. ;
  1833. FINSI ;
  1834. *
  1835. SI ( ( YTW1 EGA 0. 1.E-6 ) ET ( EGA TAB_1.HYPERVAP VRAI ) ) ;
  1836. SM = ( TAB_1 . LARG_CANAL * TAB_1 . HMIN_CANAL ) + ( 2. * ( TAB_1 . LARG_ESP * TAB_1 . HFIN ) ) ;
  1837. PM = TAB_1 . LARG_CANAL + ( 2.* TAB_1 . HMAX_CANAL ) + ( 2. * TAB_1 . LARG_ESP ) + ( 2. * TAB_1 . HFIN ) + TAB_1 . LFIN ;
  1838. TAB_1.DH = 4. * SM / PM ;
  1839. FACV = 1. ;
  1840. * FACF = 2.25 ;
  1841. * modif 261099 calcul du rapport Strue/Sapparent
  1842. * N CURT
  1843. SI (TAB_1.HFIN > 0. ) ;
  1844.  
  1845.  
  1846. S_E1 = ((4.*TAB_1.HFIN)+(2.*TAB_1.LARG_ESP)+(TAB_1.LFIN))* (TAB_1.FF + TAB_1.f0) ;
  1847. S_E2 = ((4.*TAB_1.HFIN)+(2.*TAB_1.LARG_ESP)+(TAB_1.LFIN))* (TAB_1.FF) ;
  1848. S_E3 = 2.* (TAB_1.LFIN * (TAB_1.HFIN - TAB_1.RFIN)) ;
  1849. S_E4 = PI * ( TAB_1.RFIN * TAB_1.LFIN) ;
  1850. S_E5 = 2. * (( TAB_1.HFIN + TAB_1.LARG_ESP) * TAB_1.f0) ;
  1851. S_E6 = TAB_1.RFIN * ((2.*TAB_1.f0)-(PI* TAB_1.RFIN)) ;
  1852. FACF = (S_E2+S_E3+S_E4+S_E5+S_E6)/ S_E1 ;
  1853. SINON ;
  1854. FACF = 1. ;
  1855. FINSI ;
  1856. *fin modif
  1857.  
  1858. TAB_1.FACCF = FACF ;
  1859. TAB_1.HYP_SM = SM ;
  1860. FINSI ;
  1861. SI ( YTW1 > 0. ) ;
  1862. QUAS = 4. * ( ( PI * DIAM * DIAM / 8.) - ( TTAPE * DIAM / 2. ) ) ;
  1863. PERI = ( ( PI * DIAM / 2.) - TTAPE + DIAM ) ;
  1864. TAB_1.DH = QUAS / PERI ;
  1865. PIS2Y = PI / ( 2. * YTW1 ) ;
  1866. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  1867. FACF = 1.15 ;
  1868. FINSI ;
  1869. SI ( EXISTE TAB_1 RIP_FLOWS ) ;
  1870. S1 = ( TAB_1 . RIP_FLOWS ) ;
  1871. FINSI ;
  1872. SI ( EXISTE TAB_1 RIP_WETP ) ;
  1873. PERI = ( TAB_1 . RIP_WETP ) ;
  1874. TAB_1.DH = 4. * S1 / PERI ;
  1875. FINSI ;
  1876. SI ( EXISTE TAB_1 RIP_TWIST ) ;
  1877. PIS2Y = PI / ( 2. *( TAB_1 . RIP_TWIST ) ) ;
  1878. FACV2 = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  1879. FACV = MAXI ( PROG FACV FACV2 ) ;
  1880. FINSI ;
  1881.  
  1882. SI ( EGA TAB_1.HYPERVAP FAUX ) ;
  1883. FACD = ( DIAM / TAB_1.DH ) ** 0.2 ;
  1884. FACT = ( FACV ** 0.8 ) * FACD * FACF ;
  1885. SINON ;
  1886. FACD = 1. ;
  1887. FACT = ( FACV ** 0.8 ) * FACD * FACF ;
  1888. FINSI ;
  1889. * modif pour calcul W7x provisoire
  1890. * adaptation du coef correctif W7X du au swirl
  1891. * N CURT 18012000
  1892. * SI ( EGA TAB_1.HYPERVAP FAUX ) ;
  1893. * SI (YTW1 > 0. ) ;
  1894. * FACF = 2.18 * ((YTW1)**(-1 * 0.09)) ;
  1895. * FACF = 2.26 * ((YTW1)**(-1 * 0.248)) ;
  1896. * FACD = 1. ;
  1897. * FACV = 1. ;
  1898. * FACT = ( FACV ** 0.8 ) * FACD * FACF ;
  1899. * SINON ;
  1900. *FACD = ( DIAM / TAB_1.DH ) ** 0.2 ;
  1901. * FACT = ( FACV ** 0.8 ) * FACD * FACF ;
  1902. * FINSI ;
  1903. * SINON ;
  1904. * FACD = 1. ;
  1905. * FINSI ;
  1906. * fin modif
  1907. *
  1908. * attention modification par R. MITTEAU le 7 fevrier 1994
  1909. * j'ai rajoute les " FIXE " pour pouvoir passer un calcul
  1910. * dans lequel l'eau est quasi immobile. Car dans ce cas les valeurs
  1911. * sont en dehors des tables
  1912.  
  1913. * avant modif
  1914. *TSAT = @IPOE P_LOCAL1 TAB_1.EPTSAT ;
  1915. *NNU = @IPOE T_LOC1 TAB_1.ETNNU ;
  1916. *RHO = @IPOE T_LOC1 TAB_1.ETRHOF ;
  1917. *PR = @IPOE T_LOC1 TAB_1.ETPRAF ;
  1918. *LLAM = @IPOE T_LOC1 TAB_1.ETLLA ;
  1919. *NNUB = @IPOE T_LOC1 TAB_1.ETNNU ;
  1920.  
  1921. * apres modif raph
  1922. *MESS '>>PRESS T_MOY S1' P_LOCAL T_LOC1 ;
  1923. TSAT = @IPOE P_LOCAL1 TAB_1.EPTSAT FIXE ;
  1924. NNU = @IPOE T_LOC1 TAB_1.ETNNU FIXE ;
  1925. RHO = @IPOE T_LOC1 TAB_1.ETRHOF FIXE ;
  1926. PR = @IPOE T_LOC1 TAB_1.ETPRAF FIXE ;
  1927. LLAM = @IPOE T_LOC1 TAB_1.ETLLA FIXE ;
  1928. NNUB = @IPOE T_LOC1 TAB_1.ETNNU FIXE ;
  1929.  
  1930. *
  1931. RE = RHO * ( NNU ** -1 ) * V1 * TAB_1.DH * FACV ;
  1932. *
  1933. SI ( T_LOC1 < TSAT ) ;
  1934. LTWALL1 = PROG -52. pas 25. (T_LOC1 + 0.01) pas 25. TSAT pas 25. 350. 400. 450. 500. 1500. 2550. 3000. 3500. 20000. ;
  1935. SINON ;
  1936. LTWALL1 = PROG -52. pas 25. TSAT pas 25. 350. 400. 450. 500. 1500. 2550. 3000. 3500. 20000. ;
  1937. FINSI ;
  1938. *
  1939. LNNUW = @IPOE LTWALL1 TAB_1.ETNNU 'FIXE' ;
  1940. *modif NCURT 10012000
  1941. *calcul nb de Prandtl sur le mur
  1942. LPRW = @IPOE LTWALL1 TAB_1.ETPRAF 'FIXE' ;
  1943. *fin modif
  1944. LTETA = PROG ( DIME LTWALL1 ) * T_LOC1 ;
  1945. *
  1946. LM_ITETA = LTWALL1 MASQUE 'INFERIEUR' T_LOC1 ;
  1947. LM_STETA = LTWALL1 MASQUE 'EGSUP' T_LOC1 ;
  1948. *
  1949. *SI ( EGA TAB_1.L_CONVECT 'DITTUS_BOELTER' ) ;
  1950. NUS_2 = FACF * 0.023 * ( RE ** 0.8 ) * ( PR ** 0.4 ) ;
  1951. NUS_1 = FACF * 0.023 * ( RE ** 0.8 ) * ( PR ** 0.3 ) ;
  1952. LNUS_2 = PROG ( DIME LTWALL1 ) * NUS_2 ;
  1953. LNUS_1 = PROG ( DIME LTWALL1 ) * NUS_1 ;
  1954. LNUS = ( LNUS_1 * LM_ITETA ) + ( LNUS_2 * LM_STETA ) ;
  1955. LH_DB = LNUS * LLAM / TAB_1.DH ;
  1956. LFC_DB = ( LTWALL1 - LTETA ) * LH_DB;
  1957. TITRE 'DITTUS_BOELTER' ;
  1958. EVOFC_DB = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_DB ;
  1959. *FINSI ;
  1960. *
  1961. *SI ( EGA TAB_1.L_CONVECT 'SIEDER_TATE' ) ;
  1962. NUS1 = FACF * 0.027 * ( RE ** 0.8 ) * ( PR ** ( 1. / 3. )) ;
  1963. LNUS = ( ( LNNUW / NNUB ) ** -0.14 ) * NUS1 ;
  1964. LH_ST = LNUS * ( LLAM / TAB_1.DH ) ;
  1965. LFC_ST = ( LTWALL1 - LTETA ) * LH_ST ;
  1966. TITRE 'SIEDER_TATE' ;
  1967. EVOFC_ST = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_ST ;
  1968. *FINSI ;
  1969. *
  1970. *SI ( EGA TAB_1.L_CONVECT 'PETHUKOV' ) ;
  1971. F_P = (1. / ( 1.82 * ( ( LOG RE ) / ( LOG 10.) ) - 1.64 )) ** 2 ;
  1972. X_P = 1.07 + (12.7 * (PR ** (2. / 3.) - 1.) * ( (F_P / 8.) ** 0.5 ));
  1973. NUS1 = ( RE * PR * F_P ) / ( X_P * 8. ) ;
  1974. LNUS_2 = ( ( LNNUW / NNUB ) ** -0.11 ) * FACF * NUS1 ;
  1975. LNUS_1 = ( ( LNNUW / NNUB ) ** -0.25 ) * FACF * NUS1 ;
  1976. LNUS = (LNUS_1 * LM_ITETA) + (LNUS_2 * LM_STETA) ;
  1977. LH_P = LNUS * ( LLAM /TAB_1.DH ) ;
  1978. LFC_P = ( LTWALL1 - LTETA ) * LH_P ;
  1979. TITRE 'PETHUKOV' ;
  1980. EVOFC_P = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_P ;
  1981. *FINSI ;
  1982.  
  1983.  
  1984.  
  1985. *modif NCURT 10012000
  1986. *adaptation de la correlation non courte de Gnielinski
  1987. *cf Greuner 260499
  1988. *SI ( EGA TAB_1.L_CONVECT 'GNIELINSKI' ) ;
  1989. F_G = (1. / (1.82 * ( ( LOG RE ) / ( LOG 10.)) - 1.64 )) ** 2 ;
  1990. R_G = ( (PR ** (2. / 3.)) - 1.) * ( (F_G / 8.) ** 0.5) ;
  1991. X_G = 1. + (12.7 * R_G);
  1992. NUS3 = FACF * (((RE - 1000.)* PR) * F_G) / ( X_G * 8.) ;
  1993. * correlation courte
  1994. * NUS3 = FACF * 0.012 * ((RE ** 0.87) - 280. ) * (PR ** 0.4) ;
  1995. LNUS = ( ( LPRW / PR ) ** -0.11 ) * NUS3 ;
  1996. LH_GN = LNUS * ( LLAM/TAB_1.DH) ;
  1997. LFC_GN = ( LTWALL1 - LTETA ) * LH_GN ;
  1998. TITRE 'GNIELINSKI' ;
  1999. EVOFC_GN = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_GN ;
  2000.  
  2001. *fin modif
  2002.  
  2003.  
  2004. *SI ( EGA TAB_1.L_CONVECT 'JB_CONVEC' ) ;
  2005. SI (NON ( YTW1 EGA 0. 1.E-6 ) ) ;
  2006. FACFJB = 1. + ( 0.7 / YTW1 ) ;
  2007. SINON ;
  2008. FACFJB = 1. ;
  2009. FINSI ;
  2010. NUS_3 = FACFJB * 0.023 * ( RE ** 0.8 ) * ( PR ** 0.4 ) ;
  2011. LNUS = ( ( LNNUW / NNUB ) ** -0.25 ) * NUS_3 ;
  2012. LH_JB = LNUS * ( LLAM / TAB_1.DH ) ;
  2013. LFC_JB = ( LTWALL1 - LTETA ) * LH_JB ;
  2014. TITRE 'JB_CONVEC' ;
  2015. EVOFC_JB = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_JB ;
  2016. *FINSI ;
  2017. *
  2018. SI ( NON ( EXISTE TAB_1 L_CONVECT ) ) ;
  2019. *js TAB_1.L_CONVECT = 'DITTUS_BOELTER' ;
  2020. TAB_1.L_CONVECT = 'SIEDER_TATE' ;
  2021. FINSI ;
  2022. *
  2023. SI ( EGA TAB_1.L_CONVECT 'DITTUS_BOELTER' ) ;
  2024. LHCONV = LH_DB ;
  2025. FINSI ;
  2026. *
  2027. SI ( EGA TAB_1.L_CONVECT 'SIEDER_TATE' ) ;
  2028. LHCONV = LH_ST ;
  2029. FINSI ;
  2030. *
  2031. SI ( EGA TAB_1.L_CONVECT 'PETHUKOV' ) ;
  2032. LHCONV = LH_P ;
  2033. FINSI ;
  2034. *
  2035. SI ( EGA TAB_1.L_CONVECT 'JB_CONVEC') ;
  2036. LHCONV = LH_JB ;
  2037. FINSI ;
  2038.  
  2039. *modif 10012000
  2040. SI ( EGA TAB_1.L_CONVECT 'GNIELINSKI') ;
  2041. LHCONV = LH_GN ;
  2042. FINSI ;
  2043. *fin modif
  2044.  
  2045. *
  2046. * Calculation of TONB FONB Bergles & Rohsenow correlation
  2047. *
  2048. IONB = 0 ;
  2049. TB1 = TSAT + 15. ;
  2050. REPETER BOUCONB ;
  2051. IONB = IONB + 1 ;
  2052. SI ( IONB > 7 ) ;
  2053. QUITTER BOUCONB ;
  2054. FINSI ;
  2055. PRATIO = P_LOCAL1 * 1.E-5 ;
  2056. EXPO1 = 1. / ( 0.463 * ( PRATIO ** 0.0234 ) ) ;
  2057. DUM = ( 1. / 0.556 ) * ( TB1 - TSAT ) ;
  2058. FTBA = 1082. *( PRATIO ** 1.156 )* ( DUM ** EXPO1 ) ;
  2059. HCONV = IPOL TB1 LTWALL1 LHCONV ;
  2060. FTB = ( HCONV * ( TB1 - T_LOC1 ) ) - FTBA ;
  2061. ;
  2062. * **** CALCUL DE LA DERIVEE PAR RAPPORT A TB1-TETA **********
  2063. FTB1 = HCONV - ( ( EXPO1 * FTBA ) / ( TB1 - TSAT ) ) ;
  2064. * **** CALCUL DU NOUVEAU TB **********
  2065. TONB = TB1 - ( FTB / FTB1 ) ;
  2066. SI ( ( ABS ( TONB -TB1 ) ) &lt;EG 0.1 ) ;
  2067. QUITTER BOUCONB ;
  2068. FINSI ;
  2069. TB1 = TONB ;
  2070. FIN BOUCONB ;
  2071. MESS '>@CALHCON> TONB VALUE BY BERG.& ROHS. CORREL.: ' TONB ;
  2072. MESS '>@CALHCON> TONB PRECISION : ' ((TONB - TB1) / TONB);
  2073. *
  2074. *
  2075. SI ( T_LOC1 < TSAT ) ;
  2076. LTWALL2 = PROG -52. pas 25. (T_LOC1 + 0.01) pas 25. TSAT pas 5. (TONB + 0.01) pas 5. (TONB + 50.) pas 25. 450. 500. 1500. 3000. 2.1E4 ;
  2077. SINON ;
  2078. LTWALL2 = PROG -52. pas 25. TSAT pas 5. (TONB + 0.01) pas 5. (TONB + 50.) pas 25. 450. 500. 1500. 3000. 2.1E4 ;
  2079. FINSI ;
  2080.  
  2081. LTWALL = LTWALL2 ;
  2082. *
  2083. LHCONV = @ITPLT LTWALL1 LHCONV 'FIXE' LTWALL2 ;
  2084. LTETA = PROG ( DIME LTWALL ) * T_LOC1 ;
  2085. LTSAT = PROG ( DIME LTWALL ) * TSAT ;
  2086. LTONB = PROG ( DIME LTWALL ) * TONB ;
  2087. *
  2088. LM_ITSAT = LTWALL MASQUE 'INFERIEUR' TSAT ;
  2089. LM_STSAT = LTWALL MASQUE 'EGSUPE' TSAT ;
  2090. LM_ITONB = LTWALL MASQUE 'INFERIEUR' TONB ;
  2091. LM_STONB = LTWALL MASQUE 'EGSUPE' TONB ;
  2092. LM_ITON1 = LTWALL MASQUE 'EGINFE' TONB ;
  2093. LM_STON1 = LTWALL MASQUE 'SUPERIEUR' TONB ;
  2094. *
  2095. *SI ( EGA TAB_1.L_SUBNB 'THOM' ) ;
  2096. VEXPTM = EXP ( 1.E-5 * P_LOCAL1 / 87. ) ;
  2097. LFB_TM = ( LTWALL - LTSAT ) * ( VEXPTM / 22.65 ) ;
  2098. LFB_TM = ( LFB_TM ** 2 ) * 1.E6 ;
  2099. LFB_TM = LFB_TM * LM_STSAT ;
  2100. TITRE 'THOM' ;
  2101. EVOFB_TM = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TM ;
  2102. EVOFB_T1 = EVOFB_TM ;
  2103. *FINSI ;
  2104. *
  2105. SI ( NON ( EXISTE TAB_1 L_SUBNB ) ) ;
  2106. TAB_1.L_SUBNB = 'THOM_CEA' ;
  2107. SI ( NON ( EXISTE TAB_1 V_EXPTHOM ) ) ;
  2108. TAB_1 . V_EXPTHOM = 2.8 ;
  2109. FINSI ;
  2110. FINSI ;
  2111. *
  2112. SI ( EGA TAB_1.L_SUBNB 'THOM_CEA' ) ;
  2113. VEXPTM = EXP ( 1.E-5 * P_LOCAL1 / 87. ) ;
  2114. LFB_TM = ( LTWALL - LTSAT ) * ( VEXPTM / 22.65 ) ;
  2115. E_TMP = TAB_1.V_EXPTHOM / 2. ;
  2116. LFB_TMP = (( LFB_TM ** 2 ) ** E_TMP) * 1.E6 ;
  2117. LFB_TMP = LFB_TMP * LM_STSAT ;
  2118. TITRE 'THOM_CEA' ;
  2119. EVFB_TMP = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TMP ;
  2120. EVOFB_T1 = EVOFB_T1 ET EVFB_TMP ;
  2121. FINSI ;
  2122. *
  2123. SI ( EGA TAB_1.L_SUBNB 'T_JAERI' ) ;
  2124. VEXPTM = EXP ( 1.E-5 * P_LOCAL1 / 87. ) ;
  2125. LFB_TM = ( LTWALL - LTSAT ) * ( VEXPTM / 25.72 ) ;
  2126. E_TMJ = 3 / 2. ;
  2127. LFB_TMJ = (( LFB_TM ** 2 ) ** E_TMJ) * 1.E6 ;
  2128. LFB_TMJ = LFB_TMJ * LM_STSAT ;
  2129. TITRE 'T_JAERI' ;
  2130. EVFB_TMJ = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TMJ ;
  2131. EVOFB_T1 = EVOFB_T1 ET EVFB_TMJ ;
  2132. FINSI ;
  2133. *
  2134. *SI ( EGA TAB_1.L_SUBNB 'JENS_LOTTES' ) ;
  2135. VEXPJL = EXP ( 1.E-5 * P_LOCAL1 / 62. ) ;
  2136. LFB_JL = ( LTWALL - LTSAT ) * ( VEXPJL / 25. ) ;
  2137. LFB_JL = ( LFB_JL ** 4 ) * 1.E6 ;
  2138. LFB_JL = LFB_JL * LM_STSAT ;
  2139. TITRE 'JENS_LOTTES' ;
  2140. EVOFB_JL = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_JL ;
  2141. *FINSI ;
  2142. *
  2143. SI ( EGA TAB_1.L_SUBNB 'YIN' ) ;
  2144. D_YIN1 = 7.195 * ( TAB_1.GAM_YIN ** 1.82 ) ;
  2145. D_YIN2 = ( 1.E-5 * P_LOCAL1 ) ** 0.072 ;
  2146. LFB_YIN = ( 1.E6 * ( LTWALL - LTSAT ) ) / ( D_YIN1 * D_YIN2 ) ;
  2147. LFB_YIN = LFB_YIN * LM_STSAT ;
  2148. TITRE 'YIN' ;
  2149. EVFB_YIN = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_YIN ;
  2150. FINSI ;
  2151. *
  2152. TAC1 = TABLE ;
  2153. TAC1.1 = 'MARQ CROI REGU' ;
  2154. TAC1.2 = 'MARQ PLUS REGU' ;
  2155. TAC1.3 = 'MARQ ETOI REGU' ;
  2156. TAC1.4 = 'MARQ LOSA REGU' ;
  2157. TAC1.5 = 'MARQ CARR REGU' ;
  2158. TAC1.6 = 'MARQ TRIB REGU' ;
  2159. *
  2160. TAC2 = TABLE ;
  2161. TAC2.1 = 'MARQ CARR REGU' ;
  2162. TAC2.2 = 'MARQ LOSA REGU' ;
  2163. TAC2.3 = 'MARQ TRIA REGU' ;
  2164. TAC2.4 = 'MARQ TRIB REGU' ;
  2165. *
  2166. MESS '>@CALHCON> VELOCITY (M/S) : ' V1 ;
  2167.  
  2168. * MESS '>@CALHCON> MASS FLOW RATE ( KG/S ) : '
  2169. * (V1 * S1 * RHO) ;
  2170. MESS '>@CALHCON> FLUID TEMPERATURE (C) : ' T_LOC1 ;
  2171. MESS '>@CALHCON> FLUID PRESSURE ( PA ) : ' P_LOCAL1 ;
  2172. MESS '>@CALHCON> WATER SATURATION TEMPERATURE(C) : ' TSAT ;
  2173. *MESS '>@CALHCON> TUBE DIAMETER (M) : ' DIAM ;
  2174. MESS '>@CALHCON> TUBE HYDRAULIC DIAMETER (M) : ' TAB_1.DH ;
  2175. MESS '>@CALHCON> SWIRL TAPE THICKNESS (M) : ' TTAPE ;
  2176. MESS '>@CALHCON> TWIST RATIO : ' YTW1 ;
  2177. MESS '>@CALHCON> FLUID DENSITY ( KG/M**3) : ' RHO ;
  2178. MESS '>@CALHCON> FLUID CONDUCTIVITY ( W/M.K) : ' LLAM ;
  2179. MESS '>@CALHCON> REYNOLDS NUMBER : ' RE ;
  2180. MESS '>@CALHCON> FLUID VISCOSITY (KG/M.S) : ' NNU ;
  2181. MESS '>@CALHCON> PRANDTL NUMBER : ' PR ;
  2182. MESS '>@CALHCON> FACTOR DUE TO FIN EFFECT : ' FACF ;
  2183. MESS '>@CALHCON> FACTOR DUE TO CHANGE ON HYD.DIAM: ' FACD ;
  2184. *MESS '>@CALHCON> FACTOR DUE TO TWISTED VELOCITY : ' FACV ;
  2185. MESS '>@CALHCON> VELOCITY CORRECTION FACTOR : 'FACV ;
  2186. MESS '>@CALHCON> TOTAL FACT. DUE TO TWIST or RIP.: ' FACT ;
  2187. MESS '>@CALHCON> NUSS. HEATING NUMBER : ' ( IPOL 400. LTWALL1 LNUS ) ;
  2188. *MESS ' EXPERIMENTAL CRITICAL FLUX : ' FCR1 ;
  2189. MESS '>@CALHCON> CONV. COEF. (CONVECTION) : ' ( IPOL 400. LTWALL1 LH_DB ) ;
  2190. MESS '>@CALHCON> FC_DB (TWALL = 400 C ) :' ( IPOL 400. LTWALL1 LFC_DB ) ;
  2191. *
  2192. *
  2193. *
  2194. SI ( EGA TAB_1.L_SUBNB 'THOM' ) ;
  2195. LFB = LFB_TM ;
  2196. FINSI ;
  2197. *
  2198. SI ( EGA TAB_1.L_SUBNB 'THOM_CEA' ) ;
  2199. LFB = LFB_TMP ;
  2200. FINSI ;
  2201. *
  2202. SI ( EGA TAB_1.L_SUBNB 'T_JAERI' ) ;
  2203. LFB = LFB_TMJ ;
  2204. FINSI ;
  2205. *
  2206. SI ( EGA TAB_1.L_SUBNB 'JENS_LOTTES' ) ;
  2207. LFB = LFB_JL ;
  2208. FINSI ;
  2209. *
  2210. SI ( EGA TAB_1.L_SUBNB 'YIN' ) ;
  2211. LFB = LFB_YIN ;
  2212. TAB_1.CONNECT_METHOD = 'ADDITION' ;
  2213. FINSI ;
  2214. *
  2215. SI ( EXISTE TAB_1 AMPL_H ) ;
  2216. LHCONV = LHCONV * ( TAB_1 . AMPL_H ) ;
  2217. FINSI ;
  2218. *
  2219. LFCONV = ( LTWALL - LTETA ) * LHCONV ;
  2220. TITRE TAB_1.L_CONVECT 'CONVECTION FLUX' ;
  2221. EVOFC = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFCONV ;
  2222. TITRE TAB_1.L_SUBNB 'BOILING FLUX' ;
  2223. EVOFE = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFB ;
  2224. *
  2225. SI ( NON ( EXISTE TAB_1 CONNECT_METHOD ) ) ;
  2226. TAB_1.CONNECT_METHOD = 'BERG_ROH' ;
  2227. FINSI ;
  2228. *
  2229. SI ( EGA TAB_1.CONNECT_METHOD 'ADDITION' ) ;
  2230. TAB_1.L_SUBNB = 'YIN' ;
  2231. MESS '>@CALHCON> ADDITION DE FSPL ET FSCB CHOISIE ' ;
  2232. LFT = LFCONV + LFB ;
  2233. FINSI ;
  2234. *
  2235. SI ( EGA TAB_1.CONNECT_METHOD 'DIRECT' ) ;
  2236. PA_TEMPE = 10. ;
  2237. TEMPE_PA = TSAT ;
  2238. FLUX_DIC = @IPOE TEMPE_PA EVOFC ;
  2239. FLUX_DIE = @IPOE TEMPE_PA EVOFE ;
  2240. * Recherche du point d'intersection
  2241. REPETER BOUC_DIR ;
  2242. SI ( ( ABS ( FLUX_DIE - FLUX_DIC ) ) &lt;EG 1.E2 ) ;
  2243. QUITTER BOUC_DIR ;
  2244. FINSI ;
  2245. SI ( FLUX_DIE > FLUX_DIC ) ;
  2246. TEMPE_PA = TEMPE_PA - PA_TEMPE ;
  2247. PA_TEMPE = PA_TEMPE / 2. ;
  2248. FINSI ;
  2249. TEMPE_PA = TEMPE_PA + PA_TEMPE ;
  2250. FLUX_DIC = @IPOE TEMPE_PA EVOFC ;
  2251. FLUX_DIE = @IPOE TEMPE_PA EVOFE ;
  2252. FIN BOUC_DIR ;
  2253. RANGE_D = (LTWALL MASQUE 'INFE' 'SOMME' TEMPE_PA) + 1 ;
  2254. LTWALL_D = INSERER LTWALL RANGE_D TEMPE_PA ;
  2255. LFCONV_D = INSERER LFCONV RANGE_D FLUX_DIC ;
  2256. LFB_D = INSERER LFB RANGE_D FLUX_DIE ;
  2257. LM_IFLUX = LFCONV_D MASQUE 'INFERIEUR' FLUX_DIC ;
  2258. LM_SFLUX = LFB_D MASQUE 'EGSUPE' FLUX_DIE ;
  2259. LFCONVI = LFCONV_D * LM_IFLUX ;
  2260. LFBS = LFB_D * LM_SFLUX ;
  2261. LFT = LFCONVI + LFBS ;
  2262. LTWALL = LTWALL_D ;
  2263. LFCONV = LFCONV_D ;
  2264. LFB = LFB_D ;
  2265. LTETA = PROG ( DIME LTWALL_D ) * T_LOC1 ;
  2266. FINSI ;
  2267. *
  2268. SI ( EGA TAB_1.CONNECT_METHOD 'BERG_ROH' ) ;
  2269. LFCONV1 = LFCONV * LM_ITONB ;
  2270. LFCONV2 = LFCONV * LM_STONB ;
  2271. FB_ONB = IPOL TONB LTWALL LFB ;
  2272. LFB_ONB = PROG (DIME LTWALL) * FB_ONB ;
  2273. LDFB = ( LFB - LFB_ONB ) * LM_STONB ;
  2274. LF = ( LFCONV2 ** 2 ) + ( LDFB ** 2 ) ;
  2275. LF = LF ** 0.5 ;
  2276. LF = LF * LM_STONB ;
  2277. LFT = LFCONV1 + LF ;
  2278. FINSI ;
  2279. *
  2280. SI ( EGA TAB_1.CONNECT_METHOD 'JB_METHOD' ) ;
  2281. *
  2282. *liaison par flux = a Tparoi**10 + b
  2283. * LA_1 = ( LFB_ONB1 - LFB_ONB ) / (( LTONB1 ** 10 ) -
  2284. * ( LTONB ** 10 ) ) ;
  2285. * LB_1 = LFB_ONB - ( LA_1 * ( LTONB ** 10 ) ) ;
  2286. * LFPB = ( LA_1 * ( LTWALL_6 ** 10 ) ) + LB_1 ;
  2287. *
  2288. FB_ONB4 = IPOL TONB LTWALL LFB ;
  2289. FB_ONB5 = IPOL TONB LTWALL LFCONV ;
  2290. FB_ONB6 = 2.8 * FB_ONB5 ;
  2291. * EVFB_TMP = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TMP ;
  2292. EVFB_TM1 = EVOL MANU 'FLUX' LFB_TMP 'TEMPERATURE' LTWALL ;
  2293. T_ONB6 = @IPOE FB_ONB6 EVFB_TM1 FIXE ;
  2294. RANGE_6 = ( LTWALL MASQUE 'INFE' 'SOMME' T_ONB6 ) + 1 ;
  2295. LTWALL_6 = INSERER LTWALL RANGE_6 T_ONB6 ;
  2296. *
  2297. LM_ITON2 = LTWALL_6 MASQUE 'INFERIEUR' T_ONB6 ;
  2298. LM_STON2 = LTWALL_6 MASQUE 'EGSUPE' T_ONB6 ;
  2299. LM_ITON3 = LTWALL_6 MASQUE 'INFERIEUR' TONB ;
  2300. LM_STON3 = LTWALL_6 MASQUE 'EGSUPE' TONB ;
  2301. LFB_ONB4 = PROG ( DIME LTWALL_6 ) * FB_ONB4 ;
  2302. LFB_ONB6 = PROG ( DIME LTWALL_6 ) * FB_ONB6 ;
  2303. LTETA1 = PROG ( DIME LTWALL_6 ) * T_LOC1 ;
  2304. *
  2305. LHCONV1 = @ITPLT LTWALL LHCONV 'FIXE' LTWALL_6 ;
  2306. LFCONV1 = ( LTWALL_6 - LTETA1 ) * LHCONV1 ;
  2307. LFB1 = @ITPLT LTWALL LFB 'FIXE' LTWALL_6 ;
  2308. LFCONV2 = LFCONV1 * LM_ITON3 ;
  2309. LFCONV3 = LFCONV1 * LM_STON3 ;
  2310. LFCONV3 = LFCONV3 * LM_ITON2 ;
  2311. LB_1 = ( ( LFB_ONB6 ** 2 ) - ( LFCONV3 ** 2 ) ) / ( ( LFB_ONB6 - LFB_ONB4 ) ** 2 ) ;
  2312. * LB_1 = 1. ;
  2313. LDFB1 = ( LFB1 - LFB_ONB4 ) * LM_STON3 ;
  2314. LFT0 = ( LFCONV3 ** 2 ) + ( LB_1 * ( LDFB1 ** 2 ) ) ;
  2315. LFT0 = LFT0 ** 0.5 ;
  2316. LFT0 = LFT0 * LM_STON3 ;
  2317. LFT1 = LFCONV2 + LFT0 ;
  2318. FINSI ;
  2319. *
  2320. SI ( NON ( EXISTE TAB_1 PFIXTONB ) ) ;
  2321. TAB_1 . PFIXTONB = FAUX ;
  2322. FINSI ;
  2323. *
  2324. SI ( TAB_1 . PFIXTONB ) ;
  2325. F_ONB1 = IPOL TONB LTWALL LFT ;
  2326. LF_ONB1 = PROG (DIME LTWALL) * F_ONB1 ;
  2327. LHT = (LFT - LF_ONB1) / (LTWALL - LTONB) ;
  2328. LTETA_1 = LTONB - ( LF_ONB1 / LHT ) ;
  2329. MESS '>@CALHCON> LTETA_1 :' ;
  2330. TAB_1 . EV_TETA = EVOL MANU 'TEMPERATURE' LTWALL 'TEMPEAU' LTETA_1 ;
  2331. SINON ;
  2332. SI ( EGA TAB_1.CONNECT_METHOD 'JB_METHOD' ) ;
  2333. LFT = LFT1 ;
  2334. LHT = LFT1 / (LTWALL_6 - LTETA1 ) ;
  2335. LTWALL = LTWALL_6 ;
  2336. SINON ;
  2337. LHT = LFT / ( LTWALL - LTETA ) ;
  2338. FINSI ;
  2339. FINSI ;
  2340.  
  2341. TITRE ' HEAT TRANSFER COEFFICIENT ' ;
  2342. EVOCON = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LHT ;
  2343. *TITRE TAB_1.L_CONVECT 'CONVECTION FLUX' ;
  2344. *EVOFC = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFCONV ;
  2345. *TITRE TAB_1.L_SUBNB 'BOILING FLUX' ;
  2346. *EVOFE = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFB ;
  2347. TITRE ' COMBINED FLUX ' ;
  2348. EVOFT = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFT ;
  2349. *
  2350. TITRE ' COEF. D ECHANGE EN EBULLITION SOUS SATUREE, TONB :' TONB ;
  2351. *TITRE ' HEAT TRANSFER COEFFICIENT , TONB ' TONB ;
  2352. TITRE ' CHOSEN CORRELATIONS , TONB ' TONB ;
  2353.  
  2354. * modif raph/schlo pour couper l'echange au dessus du flux critique
  2355. * en regime transitoire, effectuee par R. MITTEAU le 16 fevrier 94
  2356. SI (EXISTE TAB_1 TRANSITOIRE) ;
  2357. SI TAB_1.TRANSITOIRE ;
  2358. SI (EXISTE TAB_1 FLUCRIT1 ) ;
  2359. EVBIDON1 = EVOL MANU LFT LTWALL ;
  2360. T_CRISE = @IPOE TAB_1.FLUCRIT1 EVBIDON1 ;
  2361. H_CRISE = @IPOE T_CRISE EVOCON ;
  2362. RANGENTI = ( LTWALL MASQUE 'INFE' 'SOMME' T_CRISE ) + 1 ;
  2363. LTWALL3 = INSERER LTWALL RANGENTI T_CRISE ;
  2364. LHT2 = INSERER LHT RANGENTI H_CRISE ;
  2365. LFT2 = INSERER LFT RANGENTI TAB_1.FLUCRIT1 ;
  2366. MASQ1 = LFT2 MASQUE EGINFE TAB_1.FLUCRIT1 ;
  2367. MASQ2 = LFT2 MASQUE SUPERIEUR TAB_1.FLUCRIT1 ;
  2368. LHT3 = (LHT2 * MASQ1 ) + MASQ2 ;
  2369. LFT3 = (LFT2 * MASQ1 ) + MASQ2 ;
  2370. TITRE ' HEAT TRANSFER COEFFICIENT ' ;
  2371. EVOCON = EVOL MANU 'TEMPERATURE' LTWALL3 'CONVECTION' LHT3 ;
  2372. TITRE ' COMBINED FLUX ' ;
  2373. EVOFT = EVOL MANU 'TEMPERATURE' LTWALL3 'CONVECTION' LFT3 ;
  2374. FINSI ;
  2375. FINSI ;
  2376. FINSI ;
  2377. *
  2378. TAB_1.T_SAT = TSAT ;
  2379. TAB_1.V_TONB = TONB ;
  2380. TAB_1.ECONVEC1 = EVOCON ;
  2381. TAB_1.EVOFE1 = EVOFE ;
  2382. *
  2383. TAC1 = TABLE ;
  2384. TAC1.1 = 'MARQ CROI REGU' ;
  2385. TAC1.2 = 'MARQ PLUS REGU' ;
  2386. TAC1.3 = 'MARQ ETOI REGU' ;
  2387. TAC1.4 = 'MARQ LOSA REGU' ;
  2388. TAC1.5 = 'MARQ CARR REGU' ;
  2389. TAC1.6 = 'MARQ TRIB REGU' ;
  2390. *
  2391. TAC2 = TABLE ;
  2392. TAC2.1 = 'MARQ CARR REGU' ;
  2393. TAC2.2 = 'MARQ LOSA REGU' ;
  2394. TAC2.3 = 'MARQ TRIA REGU' ;
  2395. TAC2.4 = 'MARQ TRIB REGU' ;
  2396. *
  2397. SI ( NON ( EXISTE TAB_1 C_TRACE ) ) ;
  2398. TAB_1.C_TRACE = FAUX ;
  2399. FINSI ;
  2400. *
  2401. SI L1TRAC ;
  2402. SI TAB_1.C_TRACE ;
  2403. SI ( EGA TAB_1.L_SUBNB 'YIN' ) ;
  2404. TITRE 'CONVECTIVE AND SUBCOOLED BOILING CORRELATIONS' ;
  2405. DESSIN ( EVOFC_DB ET EVOFC_ST ET EVOFC_P ET EVOFB_T1 ET EVOFB_JL ET EVFB_YIN) XBOR 0. 400. YBOR 0. 7.E7 LEGE TAC1 ;
  2406. SINON ;
  2407. TITRE 'CONVECTIVE AND SUBCOOLED BOILING CORRELATIONS' ;
  2408. DESSIN ( EVOFC_DB ET EVOFC_ST ET EVOFC_P ET EVOFB_T1 ET EVOFB_JL) XBOR 0. 400. YBOR 0. 7.E7 LEGE TAC1 ;
  2409. TAB_1.EVOFC_D1 = EVOFC_DB ;
  2410. TAB_1.EVOFC_S1 = EVOFC_ST ;
  2411. TAB_1.EVOFC_P1 = EVOFC_P ;
  2412. TAB_1.EVOFC_M1 = EVOFC_JB ;
  2413. TAB_1.EVOFB_T2 = EVOFB_T1 ;
  2414. TAB_1.EVOFB_J1 = EVOFB_JL ;
  2415. FINSI ;
  2416. FINSI ;
  2417. SI ( TAB_1 . PFIXTONB ) ;
  2418. DESSIN TAB_1.EV_TETA XBOR T_LOC1 400. YBOR 0. 150000. MIMA ;
  2419. FINSI ;
  2420. DESSIN ( EVOFC ET TAB_1.EVOFE1 ET EVOFT ) XBOR 0. 400. YBOR 0. 7.E7 MIMA LEGE TAC2 ;
  2421. DESSIN TAB_1.ECONVEC1 XBOR 0. 400. YBOR 0. 700000. MIMA ;
  2422. FINSI ;
  2423. TAB_1.EVOFC1 = EVOFC ;
  2424. TAB_1.EVOFT1 = EVOFT ;
  2425. *
  2426. SI (NIVEAU >EG 4) ;
  2427. MESS '-----------------------------------> exit from @CALHCON ';
  2428. FINSI ;
  2429.  
  2430. FINPROC ;
  2431. **** @CALHRAY
  2432. DEBPROC @CALHRAY TAB1*TABLE ;
  2433. MESS ' ';
  2434. *
  2435. * !!! R. MITTEAU !!! attention, procedure standard
  2436. *
  2437. * un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
  2438. * pour les mises a jour
  2439. *
  2440. *-------------------------------------------------------------------*
  2441. * *
  2442. * COEFFICIENT D ECHANGE TENANT COMPTE *
  2443. * DU RAYONNEMENT *
  2444. * *
  2445. *-------------------------------------------------------------------*
  2446. *23456789012345678901234567890123456789012345678901234567890123456789012
  2447. * 1 2 3 4 5 6 7
  2448. *
  2449. * --- entrees
  2450. *
  2451. TZERO = TAB1.'TEMP_RAYO' ;
  2452. EPS1 = TAB1.'EMISSIVITE' ;
  2453. AB_2 = TAB1.'ABSORPTION' ;
  2454. NIVEAU1 = TAB1.'NIVEAU' ;
  2455. LTRAC = TAB1.'TRAC_GRAPHE' ;
  2456.  
  2457. SI (NIVEAU1 >EG 4 ) ;
  2458. MESS '-----------------------------------> calling @CALHRAY ';
  2459. FINSI ;
  2460.  
  2461. LTEMR = PROG -5000. 0. 50. 100. 200. 300. 400. 500. 600. 700. 800. 900. 1000. 1100. 1200. 1300. 1400. 1500. 1600. 1700. 1800. 1900. 2000. 2100. 2200. 2300. 2400. 2500. 2600. 2700. 2800. 2900. 3000. 3100. 3200. 3300. 3400. 3500. 3600. 3700. 3800. 3900. 2.E4 ;
  2462. SIGMA =5.67E-8 ;
  2463. TZK = 273.3 ;
  2464. MESS '>@CALHRAY> STEFAN CONSTANT : ' SIGMA ;
  2465. MESS '>@CALHRAY> TZERO DEG. C : ' TZERO ;
  2466. MESS '>@CALHRAY> EMISSIVITY : ' EPS1 ;
  2467. MESS '>@CALHRAY> ABSORPTION : ' AB_2 ;
  2468. TZERK = TZERO + TZK ;
  2469. * MESS ' TEMP H FR ' ;
  2470. LISTH = PROG ;
  2471. LISFE = PROG ;
  2472. IH1 = 0 ;
  2473. REPETER CAH1 ( DIME LTEMR ) ;
  2474. IH1 = IH1 + 1 ;
  2475. TEMP = EXTR LTEMR IH1 ;
  2476. TEMK = TEMP + TZK ;
  2477. EPSEQ = (( 1./EPS1 ) + (1./AB_2) - 1.) ** -1 ;
  2478. * FE = SIGMA * ((EPS1 * ( TEMK ** 4 )) - (AB_2 * ( TZERK ** 4 )));
  2479. FE = SIGMA * EPSEQ *( ( TEMK ** 4 ) - ( TZERK ** 4 ) ) ;
  2480. * H1 = TEMK ** 3 ;
  2481. * H2 = ( TEMK ** 2 ) * ( TZERK ) ;
  2482. * H3 = ( TEMK ) * ( TZERK ** 2 ) ;
  2483. * H4 = TZERK ** 3 ;
  2484. * H = SIGMA * EPS1 * ( H1 + H2 + H3 + H4 ) ;
  2485. SI ( EGA TEMK TZERK 1. ) ;
  2486. H = FE / 1. ;
  2487. SINON ;
  2488. H = FE / ( TEMK - TZERK ) ;
  2489. FINSI ;
  2490. LISTH = LISTH ET ( PROG H ) ;
  2491. LISFE = LISFE ET ( PROG FE ) ;
  2492. * MESS TEMP H FE ;
  2493. FIN CAH1 ;
  2494. TITRE '>@CALHRAY> COEFFICIENT ECHANGE DE RAYONNEMENT ' ;
  2495. ERAYON = EVOL MANU 'TEMPERATURE' LTEMR 'COEFFICIENT ECHANGE' LISTH ;
  2496. TITRE '>@CALHRAY> FLUX DE CHALEUR RAYONNEE ' ;
  2497. EVOFE = EVOL MANU 'TEMPERATURE' LTEMR 'RAYONNEMENT' LISFE ;
  2498. TAB1.EVORAYT1 = EVOFE ;
  2499. TAB1.EHRAYON1 = ERAYON ;
  2500. *
  2501. SI LTRAC ;
  2502. DESSIN EVOFE XBOR 0. 3900. YBOR 0. 4.E6 ;
  2503. DESSIN ERAYON XBOR 0. 3900. YBOR 0. 1500. ;
  2504. FINSI;
  2505. *
  2506. SI (NIVEAU1 >EG 4 ) ;
  2507. MESS '-----------------------------------> exiting @CALHRAY ';
  2508. FINSI ;
  2509. FINPROC ERAYON ;
  2510. **** @CALOR
  2511. 'DEBPROC' @CALOR TAB1*'TABLE ' PUI1*FLOTTANT ;
  2512. MESS ' ' ;
  2513. * pour le calcul de la puissance voir CFLUX
  2514. *
  2515. VIN = TAB1 . V_IN ;
  2516. TIN = TAB1 . T_IN ;
  2517. CPF = @IPOE TIN TAB1.ETCPF ;
  2518. SI ( NON ( EXISTE TAB1 V_EMDOTI)) ;
  2519. RHOIN = @IPOE TIN TAB1.ETRHOF ;
  2520. NNUIN = @IPOE TIN TAB1.ETNNU ;
  2521. GIN = RHOIN * VIN ;
  2522. SI ( EXISTE TAB1 RIP_FLOWS ) ;
  2523. EMDOTI = GIN * ( TAB1 . RIP_FLOWS ) ;
  2524. SINON ;
  2525. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  2526. TAB1.HYP_SM = ( TAB1.LARG_CANAL * TAB1.HMIN_CANAL ) + ( 2. * ( TAB1.LARG_ESP * TAB1.HFIN ) ) ;
  2527. EMDOTI = GIN * TAB1.HYP_SM ;
  2528. SINON ;
  2529. PI = 3.14159 ;
  2530. DIAM1 = TAB1 . D_MAQUETTE ;
  2531. TTAPE = TAB1 . T_TAPE ;
  2532. EMDOTI = GIN * ( ( PI * DIAM1 * DIAM1 / 4. ) - ( DIAM1 * TTAPE) ) ;
  2533. FINSI ;
  2534. FINSI ;
  2535. TAB1.V_EMDOTI = EMDOTI ;
  2536. SINON ;
  2537. EMDOTI = TAB1.V_EMDOTI ;
  2538. FINSI ;
  2539. *
  2540. * Modif jb 01/04/95
  2541. * Possibilite de creer une procedure calculant
  2542. * la section de passage
  2543. *SI ( NON ( EXISTE TAB1 SP ) ) ;
  2544. * SI ( EXISTE TAB1 RIP_FLOWS ) ;
  2545. * TAB1.SP = TAB1.RIP_FLOWS ;
  2546. * FINSI ;
  2547. * SI ( EGA TAB1.HYPERVAP VRAI ) ;
  2548. * TAB1.HYP_SM = ( TAB1.LARG_CANAL * TAB1.HMIN_CANAL ) +
  2549. * ( 2. * ( TAB1.LARG_ESP * TAB1.HFIN ) ) ;
  2550. * TAB1.SP = TAB1.HYP_SM ;
  2551. * SINON ;
  2552. * PI = 3.14159 ;
  2553. * DIAM1 = TAB1 . D_MAQUETTE ;
  2554. * TTAPE = TAB1 . T_TAPE ;
  2555. * TAB1.SP = ( PI * DIAM1 * DIAM1 / 4. ) - ( DIAM1 * TTAPE) ;
  2556. * FINSI ;
  2557. *EMDOTI = GIN * TAB1.SP ;
  2558. *
  2559. DELT = PUI1 / (EMDOTI * CPF) ;
  2560. TOUT = TIN + DELT ;
  2561. TAB1.TEMPE_OUT = TOUT ;
  2562. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  2563. TAB1.'T_LOCAL' = TIN ;
  2564. TAB1.'T_MOY' = TIN ;
  2565. SINON ;
  2566. TAB1.'T_LOCAL' = TIN + ((TOUT - TIN) * TAB1.X_LOCAL) ;
  2567. TAB1.'T_MOY' = (TIN + TOUT) / 2. ;
  2568. FINSI ;
  2569. MESS '>@CALOR> TIN :' TIN ;
  2570. MESS '>@CALOR> TOUT DT :' TOUT DELT ;
  2571. MESS '>@CALOR> TMOY :' TAB1.'T_MOY' ;
  2572. MESS '>@CALOR> T_LOCAL :' TAB1.'T_LOCAL' ;
  2573. FINPROC ;
  2574. **** @CAPKPC
  2575. DEBPROC @CAPKPC EV_1*EVOLUTION PC_1*FLOTTANT D_1*FLOTTANT FL_INC*FLOTTANT NIV1/ENTIER;
  2576. *
  2577. * !!! R. MITTEAU !!! attention, procedure standard
  2578. *
  2579. * un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
  2580. * pour les mises a jour
  2581. *
  2582. * calcul du peaking factor correspondant au pourcentage PC_1
  2583. * FL_INC flux incident moyen
  2584. * EV_1 evolution donnant le flux en paroi d eau
  2585. SI (NON (EXISTE NIV1));
  2586. MESS '---------------------------------> calling @CAPKPC';
  2587. SINON;
  2588. SI (NIV1 >EG 4);
  2589. MESS '---------------------------------> calling @CAPKPC';
  2590. FINSI;
  2591. FINSI;
  2592. P_X_1 = EXTR EV_1 'ABSC' 1 ;
  2593. P_Y_1 = EXTR EV_1 'ORDO' 1 ;
  2594. N1 = DIME P_X_1 ;
  2595. VINT0 = MAXI (INTG ( EVOL MANU P_X_1 P_Y_1 )) ;
  2596. SI ( PC_1 >EG 1. ) ;
  2597. MESS ' >>>>> CAPKPC POURCENTAGE SUPERIEUR A 1 ' ;
  2598. ERRE ' >>>>> CAPKPC POURCENTAGE SUPERIEUR A 1 ' ;
  2599. FINSI ;
  2600. VA_1 = PC_1 * VINT0 ;
  2601. VINT1 = VINT0 ;
  2602. REPETER B__1 N1 ;
  2603. I_1 = DIME P_X_1 ;
  2604. P_X_2 = ENLE P_X_1 I_1 ;
  2605. P_Y_2 = ENLE P_Y_1 I_1 ;
  2606. VINT2 = MAXI (INTG ( EVOL MANU P_X_2 P_Y_2 )) ;
  2607. SI( VINT2 &lt;EG VA_1 ) ;
  2608. X_1 = EXTR P_X_1 I_1 ;
  2609. X_2 = EXTR P_X_1 (I_1 - 1) ;
  2610. Y_1 = EXTR P_Y_1 I_1 ;
  2611. Y_2 = EXTR P_Y_1 (I_1 - 1) ;
  2612. PENTE = (Y_1 - Y_2) / (X_1 - X_2) ;
  2613. DELTA = Y_2 ** 2 + ( 2. * PENTE *( VA_1 - VINT2 )) ;
  2614. SI ( DELTA < 0. ) ;
  2615. MESS ' >>>>> CAPKPC y a un truc DELTA < 0. ' ;
  2616. MESS ' >>>>> CAPKPC VINT2 VINT1 VA_1 ' VINT2 VINT1 VA_1 ;
  2617. MESS ' >>>>> CAPKPC Y_2 X_2 Y_1 X_1 ' Y_2 X_2 Y_1 X_1 ;
  2618. FINSI ;
  2619. * X_11 = X_2 + ((X_1 - X_2) / ( VINT1 - VINT2 )
  2620. * * ( VA_1 - VINT2 )) ;
  2621. RDELT = DELTA ** 0.5 ;
  2622. DX_11 = ( (-1. * Y_2) + RDELT ) / PENTE ;
  2623. X_11 = X_2 + DX_11 ;
  2624. SI ( (DX_11 * ( X_11 - X_1)) > 0. ) ;
  2625. MESS ' >>>>> CAPKPC y a un truc X_11 X_1 X_2 ' X_11 X_1 X_2;
  2626. MESS ' >>>>> CAPKPC VINT2 VINT1 VA_1 ' VINT2 VINT1 VA_1 ;
  2627. MESS ' >>>>> CAPKPC Y_2 X_2 Y_1 X_1 ' Y_2 X_2 Y_1 X_1 ;
  2628. MESS ' >>>>> CAPKPC PENTE DELTA RDELT' PENTE DELTA RDELT ;
  2629. FINSI ;
  2630. QUITTER B__1 ;
  2631. FINSI ;
  2632. P_X_1 = P_X_2 ;
  2633. P_Y_1 = P_Y_2 ;
  2634. VINT1 = VINT2 ;
  2635. FIN B__1 ;
  2636. FL_PC = VINT0 / X_11 ;
  2637. AL_1 = 2.* X_11 / D_1 ;
  2638. PKF_1 = FL_PC / FL_INC ;
  2639.  
  2640. SI (NON (EXISTE NIV1));
  2641. MESS '---------------------------------> exiting @CAPKPC';
  2642. SINON;
  2643. SI (NIV1 >EG 4);
  2644. MESS '---------------------------------> exiting @CAPKPC';
  2645. FINSI;
  2646. FINSI;
  2647. FINPROC AL_1 PKF_1 ;
  2648. **** @CBGMV
  2649. DEBPROC @CBGMV BXG*CHPOINT BYG*CHPOINT BZG*CHPOINT TAB1*TABLE ;
  2650. *
  2651. ********************************************************************
  2652. * Procedure de changement de base. On passe de la base cartesienne *
  2653. * globale de la machine definie par l'axe du tore dirige suivant *
  2654. * Z et l'axe X situe dans le plan median entre deux bobines a la *
  2655. * base cartesienne du maillage. *
  2656. * Trois cas sont etudies : 3D, 2D en coupe Phi constant et 2D en *
  2657. * coupe Theta constant. Alain MOAL (Decembre 1995-Janvier 1996) *
  2658. ********************************************************************
  2659. *
  2660. *--------------- VARIABLES D'ENTREE :
  2661. SI ((VALEUR DIME) EGA 2) ;
  2662. IPLAN = TAB1.<PLAN ;
  2663. SI (EGA IPLAN 'PHICONS') ;
  2664. CT0 = TAB1.<CENTRE_TORE ;
  2665. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  2666. P1 = TAB1.<POINT_SUR_OBJET ;
  2667. FINSI ;
  2668. SI (EGA IPLAN 'THECONS') ;
  2669. THETA0 = TAB1.<THETA0 ;
  2670. CP = TAB1.CENTRE_PLASMA ;
  2671. RP = TAB1.<RP ;
  2672. HP = TAB1.<HP ;
  2673. FINSI ;
  2674. SINON ;
  2675. CT0 = TAB1.<CENTRE_TORE ;
  2676. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  2677. P1 = TAB1.<POINT_SUR_OBJET ;
  2678. FINSI ;
  2679. ANGPHI0 = TAB1.<ANG_PHI0 ;
  2680. *------------------------------------
  2681. *
  2682. DIM0 = VALEUR DIME ;
  2683. SI (DIM0 EGA 2) ;
  2684. FINSI ;
  2685. *
  2686. SI (((DIM0 EGA 2) ET (EGA IPLAN 'PHICONS')) OU (DIM0 EGA 3)) ;
  2687. X0 Y0 Z0 = COOR CT0 ;
  2688. X1 Y1 Z1 = COOR CT1 ;
  2689. XP1 YP1 ZP1 = COOR P1 ;
  2690. *
  2691. * ---- Calcul des coordonnees du point P0, projection du point P1 de
  2692. * ---- l'objet dans le plan orthogonal a l'axe du tore en CT0.
  2693. A = X1 - X0 ;
  2694. B = Y1 - Y0 ;
  2695. C = Z1 - Z0 ;
  2696. *
  2697. SI (A EGA 0.) ;
  2698. SI (B EGA 0.) ;
  2699. XP0 = XP1 ;
  2700. YP0 = YP1 ;
  2701. ZP0 = Z0 ;
  2702. FINSI ;
  2703. SI (C EGA 0.) ;
  2704. XP0 = XP1 ;
  2705. YP0 = Y0 ;
  2706. ZP0 = ZP1 ;
  2707. FINSI ;
  2708. SI ((B NEG 0.) ET (C NEG 0.)) ;
  2709. XP0 = XP1 ;
  2710. YP0 = (-1.*B*C*ZP1 + (C*C*YP1) + (B*B*Y0) + (B*C*Z0)) /(B*B + (C*C)) ;
  2711. ZP0 = (B*ZP1 - (C*YP1) + (C*(Y0+Z0)))/(B+C);
  2712. FINSI ;
  2713. SINON ;
  2714. AUX1 = A / (A*A + (B*B) + (C*C)) ;
  2715. AUX2 = (B*B + (C*C)) / A ;
  2716. XP0 = AUX1 * (A*X0 + (B*Y0) + (C*Z0) + (AUX2*XP1) - (B*YP1) - (C*ZP1)) ;
  2717. YP0 = B * (XP0 - XP1) / A + YP1 ;
  2718. ZP0 = C * (XP0 - XP1) / A + ZP1 ;
  2719. FINSI ;
  2720. *
  2721. P0 = XP0 YP0 ZP0 ;
  2722. *
  2723. * ---- Rotation de la ligne (CT0,P0) pour l'aligner sur l'axe X
  2724. * ---- du repere global
  2725. LIG0 = CT0 D 1 P0 ;
  2726. LIG1 = LIG0 TOUR (-1.*ANGPHI0) CT0 CT1 ;
  2727. *
  2728. * ---- Calcul des 3 vecteurs unitaires du repere global
  2729. P0X = LIG1 POIN FINAL ;
  2730. DIR1 = P0X MOIN CT0 ;
  2731. VEC1 = DIR1 / (NORM DIR1) ;
  2732. DIR3 = CT1 MOIN CT0 ;
  2733. VEC3 = DIR3 / (NORM DIR3) ;
  2734. VEC2 = VEC3 PVEC VEC1 ;
  2735. *
  2736. * ---- Changement de repere
  2737. A1 B1 C1 = COOR VEC1 ;
  2738. A2 B2 C2 = COOR VEC2 ;
  2739. A3 B3 C3 = COOR VEC3 ;
  2740. *
  2741. BXM = (A1 * BXG) + (A2 * BYG) + (A3 * BZG) ;
  2742. BYM = (B1 * BXG) + (B2 * BYG) + (B3 * BZG) ;
  2743. BZM = (C1 * BXG) + (C2 * BYG) + (C3 * BZG) ;
  2744. *
  2745. SINON ;
  2746. *
  2747. * ---- en 2D pour une section a Theta constant
  2748. XCP YCP ZCP = COOR CP ;
  2749. NORM_CP = (XCP*XCP + (YCP*YCP) + (ZCP*ZCP))**0.5 ;
  2750. ANG1 = ATG XCP YCP ;
  2751. *
  2752. * ---- Rotation de (90 + ANGPHI0) par rapport a l'axe Z
  2753. BX1 = -1. * BXG * (SIN ANGPHI0) + (BYG * (COS ANGPHI0)) ;
  2754. BY1 = -1. * BXG * (COS ANGPHI0) - (BYG * (SIN ANGPHI0)) ;
  2755. BZ1 = BZG ;
  2756. *
  2757. * ---- Rotation de -THETA0 par rapport a l'axe X
  2758. BX2 = BX1 ;
  2759. BY2 = BY1 * (COS THETA0) - (BZ1 * (SIN THETA0)) ;
  2760. BZ2 = BY1 * (SIN THETA0) + (BZ1 * (COS THETA0)) ;
  2761. *
  2762. * ---- Rotation de ANG1 par rapport a l'axe Z
  2763. BXM = BX2 * (COS ANG1) + (BY2 * (SIN ANG1)) ;
  2764. BYM = -1. * BX2 * (SIN ANG1) + (BY2 * (COS ANG1)) ;
  2765. BZM = BZ2 ;
  2766. *
  2767. FINSI ;
  2768.  
  2769. SI (DIM0 EGA 2) ;
  2770. FINSI ;
  2771. *
  2772. FINPROC BXM BYM BZM ;
  2773. **** @CBGTV
  2774. DEBPROC @CBGTV BX*CHPOINT BY*CHPOINT BZ*CHPOINT THETA*CHPOINT PHI*CHPOINT ;
  2775. *
  2776. **********************************************************************
  2777. * Procedure de changement de base pour un vecteur B de coordonnees *
  2778. * BX, BY, BZ dans la base globale aux coordonnees pseudo-toroidales *
  2779. * BRHO, BTHETA, BPHI. Alain MOAL (mars 1996) *
  2780. **********************************************************************
  2781. *
  2782. *---- Rotation de Phi autour de "l'axe Theta"
  2783. BRHO1 = (COS PHI) * BX + ((SIN PHI) * BY) ;
  2784. BTHETA1 = BZ ;
  2785. BPHI1 = -1.*(SIN PHI) * BX + ((COS PHI) * BY) ;
  2786. *
  2787. *---- Rotation de Theta autour de "l'axe Phi"
  2788. BRHO = (COS THETA) * BRHO1 + ((SIN THETA) * BTHETA1) ;
  2789. BTHETA = -1.*(SIN THETA) * BRHO1 + ((COS THETA) * BTHETA1) ;
  2790. BPHI = BPHI1 ;
  2791. *
  2792. FINPROC BRHO BTHETA BPHI ;
  2793. **** @CBLMV
  2794. DEBPROC @CBLMV VXL*CHPOINT VYL*CHPOINT VZL*CHPOINT TAB1*TABLE ;
  2795. *
  2796. ********************************************************************
  2797. * Version amelioree de l'ancien @CBLMV rebaptise @ACBLM *
  2798. * Procedure de changement de base. On passe de la base cartesienne *
  2799. * locale de l'objet modelise a la base cartesienne du maillage. *
  2800. * l'axe Y est dirige du point de tangence au plasma vers le centre *
  2801. * du plasma. En 3D, L'axe X du repere local est dans la direction *
  2802. * toroidale. *
  2803. * en 2D cas PHICONS l'axe Z du repere local est l'axe toroidal *
  2804. * en 2D cas THECONS l'axe x du repere local est l'axe toroidal *
  2805. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  2806. ********************************************************************
  2807. *
  2808. *--------------- VARIABLES D'ENTREE :
  2809. CP = TAB1.CENTRE_PLASMA ;
  2810. PTG = TAB1.PT_TGPLASMA ;
  2811. SI ((VALEUR DIME) EGA 2) ;
  2812. SI (EXISTE TAB1 <PLAN) ;
  2813. IPLAN = TAB1.<PLAN ;
  2814. SINON ;
  2815. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  2816. FINSI ;
  2817. SINON ;
  2818. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  2819. DIR1 = TAB1.<DIR_TOROIDAL ;
  2820. SINON ;
  2821. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  2822. FINSI ;
  2823. FINSI ;
  2824. *------------------------------------
  2825. *
  2826. SI ((VALEUR DIME) EGA 2) ;
  2827. VECT0 = CP MOINS PTG ;
  2828. VX VY = COOR VECT0 ;
  2829. *
  2830. * ---- calcul de l'angle de rotation dans le plan XY
  2831. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  2832. ANG1 = 0. ;
  2833. SINON ;
  2834. ANG1 = -1.* (ATG VX VY) ;
  2835. FINSI ;
  2836. *
  2837. SI (EGA IPLAN 'PHICONS');
  2838. * ---- Coupe 2D a Phi constant
  2839. VXL1 = VZL ;
  2840. VYL1 = VYL ;
  2841. VZL1 = VXL * (-1.);
  2842. * ---- rotation
  2843. VXM = VXL1 * (COS ANG1) + (VYL1 * (-1.) * (SIN ANG1));
  2844. VYM = VXL1 * (SIN ANG1) + (VYL1 * (COS ANG1)) ;
  2845. VZM = VZL1 ;
  2846. FINSI ;
  2847. SI (EGA IPLAN 'THECONS');
  2848. * ---- Coupe 2D a Theta constant
  2849. * ---- rotation
  2850. VXM = VXL * (COS ANG1) + (VYL * (-1.) * (SIN ANG1)) ;
  2851. VYM = VXL * (SIN ANG1) + (VYL * (COS ANG1)) ;
  2852. VZM = VZL ;
  2853. FINSI;
  2854. *
  2855. SINON ;
  2856. *
  2857. VEC1 = DIR1 / (NORM DIR1) ;
  2858. DIR2 = CP MOINS PTG ;
  2859. VEC2 = DIR2 / (NORM DIR2) ;
  2860. VEC3 = VEC1 PVEC VEC2 ;
  2861. *
  2862. A1 B1 C1 = COOR VEC1 ;
  2863. A2 B2 C2 = COOR VEC2 ;
  2864. A3 B3 C3 = COOR VEC3 ;
  2865. *
  2866. VXM = (A1 * VXL) + (A2 * VYL) + (A3 * VZL) ;
  2867. VYM = (B1 * VXL) + (B2 * VYL) + (B3 * VZL) ;
  2868. VZM = (C1 * VXL) + (C2 * VYL) + (C3 * VZL) ;
  2869. *
  2870. FINSI ;
  2871. FINPROC VXM VYM VZM ;
  2872.  
  2873. **** @CBMGV
  2874. DEBPROC @CBMGV BXM*CHPOINT BYM*CHPOINT BZM*CHPOINT TAB1*TABLE ;
  2875. *
  2876. ********************************************************************
  2877. * Procedure de changement de base. On passe de la base cartesienne *
  2878. * quelconque du maillage a la base cartesienne globale de la *
  2879. * machine definie par l'axe du tore dirige suivant Z et l'axe X *
  2880. * situe dans le plan median entre deux bobines. *
  2881. * Trois cas sont etudies : 3D, 2D en coupe Phi constant et 2D en *
  2882. * coupe Theta constant. Alain MOAL (Decembre 1995-Janvier 1996) *
  2883. ********************************************************************
  2884. *
  2885. *--------------- VARIABLES D'ENTREE :
  2886. SI ((VALEUR DIME) EGA 2) ;
  2887. IPLAN = TAB1.<PLAN ;
  2888. SI (EGA IPLAN 'PHICONS') ;
  2889. CT0 = TAB1.<CENTRE_TORE ;
  2890. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  2891. P1 = TAB1.<POINT_SUR_OBJET ;
  2892. FINSI ;
  2893. SI (EGA IPLAN 'THECONS') ;
  2894. THETA0 = TAB1.<THETA0 ;
  2895. CP = TAB1.CENTRE_PLASMA ;
  2896. RP = TAB1.<RP ;
  2897. HP = TAB1.<HP ;
  2898. FINSI ;
  2899. SINON ;
  2900. CT0 = TAB1.<CENTRE_TORE ;
  2901. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  2902. P1 = TAB1.<POINT_SUR_OBJET ;
  2903. FINSI ;
  2904. ANGPHI0 = TAB1.<ANG_PHI0 ;
  2905. *------------------------------------
  2906. *
  2907. DIM0 = VALEUR DIME ;
  2908. SI (DIM0 EGA 2) ;
  2909. FINSI ;
  2910. *
  2911. SI (((DIM0 EGA 2) ET (EGA IPLAN 'PHICONS')) OU (DIM0 EGA 3)) ;
  2912. * ---- en 3D ou en 2D pour la section Phi constant
  2913. X0 Y0 Z0 = COOR CT0 ;
  2914. X1 Y1 Z1 = COOR CT1 ;
  2915. XP1 YP1 ZP1 = COOR P1 ;
  2916. *
  2917. * ---- Calcul des coordonnees du point P0, projection du point P1 de
  2918. * ---- l'objet dans le plan orthogonal a l'axe du tore en CT0.
  2919. A = X1 - X0 ;
  2920. B = Y1 - Y0 ;
  2921. C = Z1 - Z0 ;
  2922. *
  2923. SI (A EGA 0.) ;
  2924. SI (B EGA 0.) ;
  2925. XP0 = XP1 ;
  2926. YP0 = YP1 ;
  2927. ZP0 = Z0 ;
  2928. FINSI ;
  2929. SI (C EGA 0.) ;
  2930. XP0 = XP1 ;
  2931. YP0 = Y0 ;
  2932. ZP0 = ZP1 ;
  2933. FINSI ;
  2934. SI ((B NEG 0.) ET (C NEG 0.)) ;
  2935. XP0 = XP1 ;
  2936. YP0 = (-1.*B*C*ZP1 + (C*C*YP1) + (B*B*Y0) + (B*C*Z0)) /(B*B + (C*C)) ;
  2937. ZP0 = (B*ZP1 - (C*YP1) + (C*(Y0+Z0)))/(B+C);
  2938. FINSI ;
  2939. SINON ;
  2940. AUX1 = A / (A*A + (B*B) + (C*C)) ;
  2941. AUX2 = (B*B + (C*C)) / A ;
  2942. XP0 = AUX1 * (A*X0 + (B*Y0) + (C*Z0) + (AUX2*XP1) - (B*YP1) - (C*ZP1)) ;
  2943. YP0 = B * (XP0 - XP1) / A + YP1 ;
  2944. ZP0 = C * (XP0 - XP1) / A + ZP1 ;
  2945. FINSI ;
  2946. *
  2947. P0 = XP0 YP0 ZP0 ;
  2948. *
  2949. * ---- Rotation de la ligne (CT0,P0) pour l'aligner sur l'axe X
  2950. * ---- du repere global
  2951. LIG0 = CT0 D 1 P0 ;
  2952. LIG1 = LIG0 TOUR (-1.*ANGPHI0) CT0 CT1 ;
  2953. *
  2954. * ---- Calcul des 3 vecteurs unitaires du repere global
  2955. P0X = LIG1 POIN FINAL ;
  2956. DIR1 = P0X MOIN CT0 ;
  2957. VEC1 = DIR1 / (NORM DIR1) ;
  2958. DIR3 = CT1 MOIN CT0 ;
  2959. VEC3 = DIR3 / (NORM DIR3) ;
  2960. VEC2 = VEC3 PVEC VEC1 ;
  2961. *
  2962. * ---- Changement de repere
  2963. A1 B1 C1 = COOR VEC1 ;
  2964. A2 B2 C2 = COOR VEC2 ;
  2965. A3 B3 C3 = COOR VEC3 ;
  2966. *
  2967. BXG = (A1 * BXM) + (B1 * BYM) + (C1 * BZM) ;
  2968. BYG = (A2 * BXM) + (B2 * BYM) + (C2 * BZM) ;
  2969. BZG = (A3 * BXM) + (B3 * BYM) + (C3 * BZM) ;
  2970. *
  2971. SINON ;
  2972. * ---- en 2D pour une section a Theta constant
  2973. *
  2974. XCP YCP ZCP = COOR CP ;
  2975. NORM_CP = (XCP*XCP + (YCP*YCP) + (ZCP*ZCP))**0.5 ;
  2976. ANG1 = ATG XCP YCP ;
  2977. *
  2978. * ---- Rotation de - ANG1 par rapport a l'axe Z
  2979. BX1 = BXM * (COS ANG1) - (BYM * (SIN ANG1)) ;
  2980. BY1 = BXM * (SIN ANG1) + (BYM * (COS ANG1)) ;
  2981. BZ1 = BZM ;
  2982. *
  2983. * ---- Rotation de THETA0 par rapport a l'axe X
  2984. BX2 = BX1 ;
  2985. BY2 = BY1 * (COS THETA0) + (BZ1 * (SIN THETA0)) ;
  2986. BZ2 = -1. * BY1 * (SIN THETA0) + (BZ1 * (COS THETA0)) ;
  2987. *
  2988. * ---- Rotation de -(90 + ANGPHI0) par rapport a l'axe Z
  2989. BXG = -1. * BX2 * (SIN ANGPHI0) - (BY2 * (COS ANGPHI0)) ;
  2990. BYG = BX2 * (COS ANGPHI0) - (BY2 * (SIN ANGPHI0)) ;
  2991. BZG = BZ2 ;
  2992. *
  2993. FINSI;
  2994. *
  2995. SI (DIM0 EGA 2) ;
  2996. FINSI ;
  2997. *
  2998. FINPROC BXG BYG BZG ;
  2999.  
  3000. **** @CBMLV
  3001. DEBPROC @CBMLV VXM*CHPOINT VYM*CHPOINT VZM*CHPOINT TAB1*TABLE ;
  3002. *
  3003. ********************************************************************
  3004. * Version amelioree de l'ancien @CBMLV rebaptise @ACBML *
  3005. * Procedure de changement de base. On passe de la base cartesienne *
  3006. * du maillage a la base cartesienne locale de l'objet modelise. *
  3007. * l'axe Y final est dirige du point de tangence vers le centre du *
  3008. * plasma. En 3D l'axe x du repere local est donne par la direction *
  3009. * toroidale *
  3010. * en 2D cas PHICONS l'axe Z initial est l'axe toroidal *
  3011. * en 2D cas THECONS l'axe x initial est l'axe toroidal *
  3012. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  3013. ********************************************************************
  3014. *
  3015. *--------------- VARIABLES D'ENTREE :
  3016. CP = TAB1.CENTRE_PLASMA ;
  3017. PTG = TAB1.PT_TGPLASMA ;
  3018. SI ((VALEUR DIME) EGA 2) ;
  3019. SI (EXISTE TAB1 <PLAN) ;
  3020. IPLAN = TAB1.<PLAN ;
  3021. SINON ;
  3022. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  3023. FINSI ;
  3024. SINON ;
  3025. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  3026. DIR1 = TAB1.<DIR_TOROIDAL ;
  3027. SINON ;
  3028. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  3029. FINSI ;
  3030. FINSI ;
  3031. *------------------------------------
  3032. *
  3033. SI ((VALEUR DIME) EGA 2) ;
  3034. VECT0 = CP MOINS PTG ;
  3035. VX VY = COOR VECT0 ;
  3036. *
  3037. * ---- calcul de l'angle de rotation dans le plan XY
  3038. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  3039. ANG1 = 0. ;
  3040. SINON ;
  3041. ANG1 = -1.* (ATG VX VY) ;
  3042. FINSI ;
  3043. *
  3044. * ---- rotation pour aligner l'axe Y avec VECT0
  3045. SI (EGA IPLAN 'PHICONS');
  3046. * ---- Coupe 2D a Phi constant
  3047. VXL1 = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  3048. VYL1 = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  3049. VZL1 = VZM ;
  3050. * ---- Coupe 2D a Phi constant
  3051. VXL = VZL1 ;
  3052. VYL = VYL1 ;
  3053. VZL = VXL1 * (-1.);
  3054. FINSI ;
  3055. SI (EGA IPLAN 'THECONS');
  3056. * ---- Coupe 2D a Theta constant
  3057. * ---- rotation
  3058. VXL = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  3059. VYL = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  3060. VZL = VZM ;
  3061. FINSI ;
  3062. *
  3063. SINON ;
  3064. *
  3065. VEC1 = DIR1 / (NORM DIR1) ;
  3066. DIR2 = CP MOINS PTG ;
  3067. VEC2 = DIR2 / (NORM DIR2) ;
  3068. VEC3 = VEC1 PVEC VEC2 ;
  3069. *
  3070. A1 B1 C1 = COOR VEC1 ;
  3071. A2 B2 C2 = COOR VEC2 ;
  3072. A3 B3 C3 = COOR VEC3 ;
  3073. *
  3074. VXL = (A1 * VXM) + (B1 * VYM) + (C1 * VZM) ;
  3075. VYL = (A2 * VXM) + (B2 * VYM) + (C2 * VZM) ;
  3076. VZL = (A3 * VXM) + (B3 * VYM) + (C3 * VZM) ;
  3077. *
  3078. FINSI ;
  3079. FINPROC VXL VYL VZL ;
  3080. **** @CBTGV
  3081. DEBPROC @CBTGV BRHO*CHPOINT BTHETA*CHPOINT BPHI*CHPOINT THETA*CHPOINT PHI*CHPOINT ;
  3082. *
  3083. *********************************************************************
  3084. * Procedure de changement de base pour un vecteur B de coordonnees *
  3085. * BRHO, BPHI, BTHETA dans une base pseudo-toroidale aux coordonnees *
  3086. * cartesiennes BX, BY, BZ dans la base globale de la machine. *
  3087. * Alain MOAL (decembre 1995) *
  3088. *********************************************************************
  3089. *
  3090. *---- Rotation de - Theta autour de "l'axe Phi"
  3091. BRHO1 = (COS THETA) * BRHO - ((SIN THETA) * BTHETA) ;
  3092. BTHETA1 = (SIN THETA) * BRHO + ((COS THETA) * BTHETA) ;
  3093. BPHI1 = BPHI ;
  3094. *
  3095. *---- Rotation de - Phi autour de "l'axe Theta"
  3096. BRHO2 = (COS PHI) * BRHO1 - ((SIN PHI) * BPHI1) ;
  3097. BTHETA2 = BTHETA1 ;
  3098. BPHI2 = (SIN PHI) * BRHO1 + ((COS PHI) * BPHI1) ;
  3099. *
  3100. BX = BRHO2 ;
  3101. BY = BPHI2 ;
  3102. BZ = BTHETA2 ;
  3103. *
  3104. FINPROC BX BY BZ ;
  3105. **** @CBTLV
  3106. DEBPROC @CBTLV BRHO*CHPOINT BTHETA*CHPOINT BPHI*CHPOINT THETA*CHPOINT PHI*CHPOINT TAB1*TABLE ;
  3107. *
  3108. *********************************************************************
  3109. * Procedure de changement de base pour un vecteur B de coordonnees *
  3110. * BRHO, BPHI, BTHETA dans une base pseudo-toroidale aux coordonnees *
  3111. * cartesiennes BX, BY, BZ dans la base de l'objet. *
  3112. * Alain MOAL (juin 1995) *
  3113. *********************************************************************
  3114. *
  3115. *--------------- VARIABLES D'ENTREE :
  3116. THETA0 = TAB1.<THETA0 ;
  3117. *------------------------------------
  3118. *
  3119. CT = COS THETA ;
  3120. ST = SIN THETA ;
  3121. CT0 = COS THETA0 ;
  3122. ST0 = SIN THETA0 ;
  3123. MST0 = ST0 * -1. ;
  3124. CPHI = COS PHI ;
  3125. SPHI = SIN PHI ;
  3126. MSPHI= SPHI * -1. ;
  3127. *
  3128. *---- 1) rotation de - Theta autour de "l'axe Phi"
  3129. BRHO1 = (CT * BRHO) - (ST * BTHETA) ;
  3130. BTHETA1 = (ST * BRHO) + (CT * BTHETA) ;
  3131. BPHI1 = BPHI ;
  3132. *
  3133. *---- 2) rotation de - Phi autour de "l'axe Theta"
  3134. BRHO2 = (CPHI * BRHO1) + (MSPHI * BPHI1) ;
  3135. BTHETA2 = BTHETA1 ;
  3136. BPHI2 = (SPHI * BRHO1) + (CPHI * BPHI1) ;
  3137. *
  3138. *---- 3) rotation de Theta0 autour de "l'axe Phi"
  3139. BRHO3 = (BRHO2 * CT0) + (BTHETA2 * ST0) ;
  3140. BTHETA3 = (BRHO2 * MST0) + (BTHETA2 * CT0) ;
  3141. BPHI3 = BPHI2 ;
  3142. *
  3143. *---- 4) composantes dans le repere cartesien
  3144. BX = BPHI3 ;
  3145. BY = BRHO3 * -1. ;
  3146. BZ = BTHETA3 ;
  3147. *
  3148. FINPROC BX BY BZ;
  3149. **** PROP_PHY
  3150. DEBPROC PROP_PHY TAB_1*TABLE ;
  3151. ******************************************************************************
  3152. ***** CELATA94 *****
  3153. ******************************************************************************
  3154. * CALCUL DU FLUX CRITIQUE SUIVANT LA CORRELATION DE CELATA 94
  3155. *_____________________________________________________________________________
  3156. *
  3157. *
  3158. *
  3159. *-----------------------------------------------------
  3160. * Calcul des proprietes de l eau a la temperature de
  3161. * saturation correspondant a la pression de sortie
  3162. *-----------------------------------------------------
  3163. *
  3164. @TABEAU TAB_1 ;
  3165. POUT = TAB_1.'P_LOCAL' ;
  3166. TAB_1.TTSAT = @IPOE POUT TAB_1.EPTSAT ;
  3167. TSAT = TAB_1.TTSAT ;
  3168. TAB_1.CCPLOUT = @IPOE TSAT TAB_1.ETCPF ;
  3169. TAB_1.RRHOL = @IPOE TSAT TAB_1.ETRHOF ;
  3170. TAB_1.RRHOV = @IPOE TSAT TAB_1.ETRHOG ;
  3171. TAB_1.LLLV = @IPOE TSAT TAB_1.ETHFG ;
  3172. TAB_1.LLAM = @IPOE TSAT TAB_1.ETLLA ;
  3173. TAB_1.SSIGM = @IPOE TSAT TAB_1.ETSIGM ;
  3174. TAB_1.MMUL = @IPOE TSAT TAB_1.ETNNU ;
  3175. TAB_1.PPRAL = @IPOE TSAT TAB_1.ETPRAF ;
  3176. *
  3177. *-----------------------------------------------------
  3178. * Calcul des proprietes de l eau a la temperature d entree
  3179. *-----------------------------------------------------
  3180. *
  3181. TIN = TAB_1.'T_LOCAL' ;
  3182. TAB_1.CCPLIN = @IPOE TIN TAB_1.ETCPF ;
  3183. TAB_1.RRHOLIN = @IPOE TIN TAB_1.ETRHOF ;
  3184. *
  3185. *-----------------------------------------------------
  3186. * Calcul de quantites utiles
  3187. *-----------------------------------------------------
  3188. *
  3189. PI = 3.1415926 ;
  3190. D = TAB_1.D_MAQUETTE ;
  3191. SI ( NON ( EXISTE TAB_1 T_TAPE ) ) ;
  3192. TAB_1 . T_TAPE = 0. ;
  3193. FINSI ;
  3194. TTAPE = TAB_1 . T_TAPE ;
  3195. SI ( NON ( EXISTE TAB_1 TWIST_RATIO ) ) ;
  3196. TAB_1 . TWIST_RATIO = 0. ;
  3197. FINSI ;
  3198. YTWIST = TAB_1 . TWIST_RATIO ;
  3199. VIN = TAB_1.'V_LOCAL' ;
  3200. *
  3201. *-----------------------------------------------------
  3202. * Prise en compte de l insert torsade
  3203. *-----------------------------------------------------
  3204. *
  3205. SI ( YTWIST EGA 0. ) ;
  3206. TAB_1 . DDH = D ;
  3207. FACV = 1. ;
  3208. VP = VIN ;
  3209. FINSI ;
  3210. SI ( YTWIST > 0. ) ;
  3211. QUAS = 4. * (( PI * D * D / 8. ) - ( TTAPE * D / 2. )) ;
  3212. PERI = (( PI * D / 2. ) - TTAPE + D ) ;
  3213. DH = QUAS / PERI ;
  3214. TAB_1 . DDH = DH ;
  3215. PIS2Y = PI / ( 2. * YTWIST ) ;
  3216. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** ( 1. / 2. ) ;
  3217. FINSI ;
  3218. *-----------------------------------------------------
  3219. * Prise en compte du fil helicoidal
  3220. *-----------------------------------------------------
  3221. *
  3222. SI ( NON ( EXISTE TAB_1 HELI_WIRE ) ) ;
  3223. TAB_1.HELI_WIRE = FAUX ;
  3224. FINSI ;
  3225. SI ( ( YTWIST EGA 0. ) ET ( EGA TAB_1.HELI_WIRE VRAI ) ) ;
  3226. S1 = PI * D1 * D1 / 4. ;
  3227. SM = PI * TAB_1.WIRE_D * TAB_1.WIRE_D / 4. ;
  3228. P1 = PI * D ;
  3229. PM = PI * TAB_1.WIRE_D ;
  3230. DH = 4. * ( S1 - SM ) / ( P1 + PM ) ;
  3231. PIS2Y = PI / ( 2 * TAB_1.PITCH_WIRE ) ;
  3232. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  3233. * FACV = 1. ;
  3234. FINSI ;
  3235. *
  3236. *-----------------------------------------------------
  3237. * Calcul de la vitesse
  3238. *-----------------------------------------------------
  3239. *
  3240. SI (NON (EXISTE TAB_1 FF_SANDIA)) ;
  3241. TAB_1 . FF_SANDIA = FAUX ;
  3242. FINSI ;
  3243. F_SANDIA = TAB_1 . FF_SANDIA ;
  3244. SI ( F_SANDIA EGA VRAI ) ;
  3245. FACV = 1. ;
  3246. FINSI ;
  3247. VP = VIN * FACV ;
  3248. TAB_1 . VITPAROI = VP ;
  3249. *
  3250. *-----------------------------------------------------
  3251. * Prise en compte du chauffage non asymetrique
  3252. *-----------------------------------------------------
  3253. *
  3254. LH = TAB_1 . L_HEATED ;
  3255. SI ( NON ( EXISTE TAB_1 CCHAU_SYM ) ) ;
  3256. TAB_1 . CCHAU_SYM = VRAI ;
  3257. FINSI ;
  3258. SI ( TAB_1 . CCHAU_SYM EGA VRAI ) ;
  3259. TAB_1.HHAR = PI * D * LH ;
  3260. AR = PI * D * D / 4. ;
  3261. SINON ;
  3262. QUAS = 4. * (( PI * D * D / 8. ) - ( TTAPE * D / 2. )) ;
  3263. AR = QUAS / 4. ;
  3264. ** PERI = (( PI * D / 2. ) - TTAPE ) ;
  3265. ** DHC = QUAS / PERI ;
  3266. ** TAB_1.HHAR = PI * ( D / 2. ) * LH ;
  3267. TAB_1.HHAR = D * LH ;
  3268. FINSI ;
  3269. *
  3270. MUL = TAB_1.MMUL ;
  3271. RHOLIN = TAB_1.RRHOLIN ;
  3272. G = RHOLIN * VP ;
  3273. TAB_1.GGAM = RHOLIN * VP * AR ;
  3274. TAB_1.GG = G ;
  3275. REYL = G * TAB_1 . DDH / MUL ;
  3276. *
  3277. *-----------------------------------------------------
  3278. * Calcul du coefficient de frottement
  3279. *-----------------------------------------------------
  3280. *
  3281. * Facteur de Sandia
  3282. * multiplier le coefficient de frottement par
  3283. * 2.75 * ( YTWIST ** ( - 0.406 ) )
  3284. * 2.2 * ( YTWIST ** ( - 0.406 ) )
  3285. FA = 4. * 1.375E-3 * (( 1. + ( 21.544 * ( 0.00375 /( TAB_1 . DDH * 1000. / 2. ))) + ( 100. / REYL )) ** ( 1. / 3. )) ;
  3286. SI ( ( F_SANDIA EGA VRAI ) ET ( YTWIST NEG 0. ) ) ;
  3287. * FA = FA * (2.75 / ( YTWIST ** ( 0.406 ) )) ;
  3288. FA = FA * (2.2 / ( YTWIST ** ( 0.406 ) )) ;
  3289. FINSI ;
  3290. SIGM = TAB_1.SSIGM ;
  3291. RHOL = TAB_1.RRHOL ;
  3292. REPETER BOUCFA 100 ;
  3293. RADEFF = 1.14 - ( 2. * ( LOG ((( 0.72 * SIGM * RHOL ) / ( FA * TAB_1 . DDH * ( G**2 ))) + ( 9.35 / ( REYL *( FA **( 1. / 2. ))))))/( LOG 10 )) ;
  3294. DIF1 = ( RADEFF ** (-2))- FA ;
  3295. DELTAF = ABS (DIF1) ;
  3296. FA = RADEFF**(-2) ;
  3297. SI ( ( F_SANDIA EGA VRAI ) ET ( YTWIST NEG 0. ) ) ;
  3298. * FA = FA * (2.75 * ( YTWIST ** ( -0.406 ) )) ;
  3299. FA = FA * (2.2 * ( YTWIST ** ( -0.406 ) )) ;
  3300. TAB_1.FFA = FA ;
  3301. SINON ;
  3302. TAB_1.FFA = FA ;
  3303. FINSI ;
  3304. SI (DELTAF &lt;EG 1.E-6) ;
  3305. QUITTER BOUCFA ;
  3306. FINSI ;
  3307. FIN BOUCFA ;
  3308. FINPROC ;
  3309. *
  3310. *_____________________________________________________________________________
  3311. *
  3312. **** QCALCO
  3313. DEBPROC QCALCO TAB_1*TABLE Q*FLOTTANT ;
  3314. *
  3315. TIN = TAB_1.T_IN ;
  3316. TSAT = TAB_1.TTSAT ;
  3317. GAM = TAB_1.GGAM ;
  3318. G = TAB_1.GG ;
  3319. HAR = TAB_1.HHAR ;
  3320. *
  3321. *-----------------------------------------------------
  3322. * Calcul de la temperature moyenne du fluide
  3323. *-----------------------------------------------------
  3324. *
  3325. CPLIN = TAB_1.CCPLIN ;
  3326. CPLOUT = TAB_1.CCPLOUT ;
  3327. CPLMED = ( CPLIN + CPLOUT )/ 2. ;
  3328. *MESS ' CPLIN = ' CPLIN ;
  3329. *MESS ' CPLOUT = ' CPLOUT ;
  3330. *MESS ' CPLMED = ' CPLMED ;
  3331. *MESS ' HAR = ' HAR ;
  3332. *MESS ' GAM = ' GAM ;
  3333. *MESS ' Q = ' Q ;
  3334. *TMED = TIN + (( Q * HAR )/( GAM * CPLMED )) ;
  3335. TMED = TIN + (( Q * HAR )/( GAM * CPLIN )) ;
  3336. * MESS 'MEAN FLUID TEMPERATURE (C) :' TMED ;
  3337. *
  3338. *-----------------------------------------------------
  3339. * Calcul de la temperature de la paroi
  3340. *-----------------------------------------------------
  3341. *
  3342. FA = TAB_1.FFA ;
  3343. RHOL = TAB_1.RRHOL ;
  3344. PRAL = TAB_1.PPRAL ;
  3345. MUL = TAB_1.MMUL ;
  3346. D = TAB_1.D_MAQUETTE ;
  3347. *MESS ' FA =' FA ;
  3348. *MESS ' RHOL = ' RHOL ;
  3349. *MESS ' PRAL = ' PRAL ;
  3350. *MESS ' MUL = ' MUL ;
  3351. *MESS ' D = ' D ;
  3352. UTAU = ( FA * ( G **2 ))/(8.*( RHOL**2 ))**(1./2.) ;
  3353. *MESS ' UTAU =' UTAU ;
  3354. QU = Q /(RHOL * CPLOUT * UTAU) ;
  3355. *MESS ' QU = ' QU ;
  3356. R = D / 2. ;
  3357. TT = 1. + (5.* PRAL ) ;
  3358. *MESS ' TT = ' TT ;
  3359. XX = ( R * UTAU * RHOL )/ MUL ;
  3360. *MESS ' XX = ' XX ;
  3361. ZZ = XX - 30. ;
  3362. TW = TMED + ( ( 5. * QU / XX ) * ( (( PRAL / 2. ) * (( 2. * XX ) - 5. )) + (( 5. / PRAL ) * (( TT * ( LOG TT )) + ( 1. - TT ))) + ( ZZ * ( LOG TT )) + (( 1. / 2. ) * ((( LOG ( XX / 30. )) * XX ) + ( 30. - XX ))) ));
  3363. MESS '>QCALCO> WALL TEMPERATURE (C) : ' TW ;
  3364. * MESS ' SATURATION TEMPERATURE (C) : ' TSAT ;
  3365. SI ( TW &lt;EG TSAT ) ;
  3366. IFLAG = 1 ;
  3367. QUITTER QCALCO ;
  3368. MESS '----->>>>>>>>' ;
  3369. FINSI ;
  3370. *
  3371. *-----------------------------------------------------
  3372. * Calcul de l epaisseur de la couche liquide surchauffee
  3373. *-----------------------------------------------------
  3374. *
  3375. *MESS '-----------------------------------> TW>TSAT ' ;
  3376. DT1 = QU * PRAL * 5. ;
  3377. DT2 = 5.* QU * ( PRAL + ( LOG ( 1. + ( 5. * PRAL )))) ;
  3378. SI (( TW - TSAT ) < DT1 ) ;
  3379. YPIU = ( TW - TSAT )/( QU * PRAL ) ;
  3380. SINON ;
  3381. SI (( TW - TSAT ) < DT2 ) ;
  3382. YPIU = 5. + ( ( 5. / PRAL )* ( EXP (( TW - TSAT )/( 5. * QU )- PRAL )- 1. )) ;
  3383. SINON ;
  3384. AA1 = ( TW - TSAT )/( 5. * QU ) ;
  3385. AA2 = 1. + ( 5. * PRAL ) ;
  3386. AA = ( AA1 - PRAL - ( LOG AA2 )) * 2. ;
  3387. YPIU = 30.* (EXP AA) ;
  3388. FINSI ;
  3389. FINSI ;
  3390. YSTAR = ( YPIU * MUL )/( UTAU * RHOL ) ;
  3391. * MESS ' SUPERHEATED LAYER THICKNESS (m) : ' YSTAR ;
  3392. *
  3393. *-----------------------------------------------------
  3394. * Calcul de l epaisseur de l amas de vapeur et de
  3395. * sa distance de la paroi chauffee
  3396. *-----------------------------------------------------
  3397. *
  3398. SIGM = TAB_1.SSIGM ;
  3399. DB = ( 32. / FA ) * ( SIGM * 0.03 * RHOL /( G**2 )) ;
  3400. DELTA = YSTAR - DB ;
  3401. * MESS ' INITIAL LIQUID SUBLAYER THICKNESS (m) : ' DELTA ;
  3402. SI (DELTA &lt;EG 0.) ;
  3403. IFLAG = 1 ;
  3404. QUITTER QCALCO ;
  3405. FINSI ;
  3406. *
  3407. *-----------------------------------------------------
  3408. * Calcul des parametres de l amas de vapeur
  3409. *-----------------------------------------------------
  3410. *
  3411. YPIU = ( DELTA + ( DB / 2. ))* UTAU * RHOL / MUL ;
  3412. SI ( YPIU &lt;EG 5.) ;
  3413. UBL = YPIU * UTAU ;
  3414. * MESS ' YPIU &lt;EG 5. ' ;
  3415. * MESS ' UBL = ' UBL ;
  3416. SINON ;
  3417. SI ( YPIU &lt;EG 30.) ;
  3418. UBL = (( 5. * ( LOG YPIU ) - 3.05 )) * UTAU ;
  3419. * MESS ' YPIU &lt;EG 30. ' ;
  3420. * MESS ' UBL = ' UBL ;
  3421. SINON ;
  3422. UBL = (( 2.5 *( LOG YPIU )) + 5.5 )* UTAU ;
  3423. * MESS ' YPIU > 30. ' ;
  3424. * MESS ' UBL = ' UBL ;
  3425. FINSI ;
  3426. FINSI ;
  3427. RHOV = TAB_1.RRHOV ;
  3428. SI ( NON ( EXISTE TAB_1 FFLOW_HO ) ) ;
  3429. TAB_1 . FFLOW_HO = VRAI ;
  3430. FINSI ;
  3431. SI ( NON ( EXISTE TAB_1 FFLOW_VE ) ) ;
  3432. TAB_1 . FFLOW_VE = FAUX ;
  3433. FINSI ;
  3434. SI ( TAB_1 . FFLOW_HO EGA VRAI ) ;
  3435. UB = UBL ;
  3436. FINSI ;
  3437. SI ( TAB_1 . FFLOW_VE EGA VRAI ) ;
  3438. CD = (2./3.) * DB /(( SIGM /( 9.81 *( RHOL - RHOV )))**(1./2.)) ;
  3439. PI = 3.1415926 ;
  3440. C1 = (( 4.* PI * 9.81 *( RHOL + RHOV ) * ( RHOL - RHOV )) /(( RHOL **2 )* RHOV * CD)) ** (1./2.) ;
  3441. UB1 = ( UBL + ((( UBL **2 ) + ( 4. * C1))**(1./2.)))/2. ;
  3442. UB2 = ( UBL - ((( UBL **2 ) + ( 4. * C1))**(1./2.)))/2. ;
  3443. *UB2<0 toujours
  3444. UB = UB1 ;
  3445. *MESS ' CD = ' CD ;
  3446. *MESS ' C1 = ' C1 ;
  3447. FINSI ;
  3448. *MESS ' UB = ' UB ;
  3449. BLB = (2.*PI*SIGM*(RHOL+RHOV))/(RHOL*RHOV*(UB**2)) ;
  3450. SI (UB &lt;EG 0.) ;
  3451. MESS 'UB<=0 *** ' ;
  3452. IFLAG = 1 ;
  3453. QUITTER QCALCO ;
  3454. FINSI ;
  3455. TAU = BLB/UB ;
  3456. *MESS ' TAU = ' TAU ;
  3457. *MESS ' IFLAG = ' IFLAG ;
  3458. * MESS ' VAPOR BLANKET VELOCITY (m/s) : ' UB ;
  3459. * MESS ' VAPOR BLANKET LENGTH (m) : ' BLB ;
  3460. FINPROC DELTA UB UBL BLB TAU IFLAG ;
  3461. *
  3462. *_____________________________________________________________________________
  3463. *
  3464. **** QUQU
  3465. DEBPROC QUQU TAB_1*TABLE Q*FLOTTANT ;
  3466. *
  3467. DELTA = 0. ;
  3468. UB = 0. ;
  3469. UBL = 0. ;
  3470. BLB = 0. ;
  3471. TAU = 0. ;
  3472. DELTA UB UBL BLB TAU IFLAG = QCALCO TAB_1 Q ;
  3473. SI (IFLAG NEG 0) ;
  3474. * MESS ' On quitte la procedure QUQU sans definir FQ ';
  3475. QUITTER QUQU ;
  3476. FINSI ;
  3477. LLV = TAB_1.LLLV ;
  3478. RHOL = TAB_1.RRHOL ;
  3479. *MESS 'DELTA =' DELTA ;
  3480. *MESS 'RHOL =' RHOL ;
  3481. *MESS 'LLV =' LLV ;
  3482. *MESS 'TAU =' TAU ;
  3483. *MESS 'UB =' UB ;
  3484. *MESS 'UBL =' UBL ;
  3485. *MESS 'Q ='Q ;
  3486. FQ = Q - ( DELTA * RHOL * LLV / TAU) ;
  3487. FINPROC FQ IFLAG ;
  3488. *
  3489. *_____________________________________________________________________________
  3490. *
  3491. **** SECANTI
  3492. DEBPROC SECANTI TAB_1*TABLE X1*FLOTTANT X2*FLOTTANT X1MIN*FLOTTANT ERRMAX*FLOTTANT NMAX*ENTIER ;
  3493. *
  3494. SI (OU (X1 >EG 10.E10) (X2 >EG 10.E10)) ;
  3495. IFLAG = 1 ;
  3496. FINSI ;
  3497. SI (IFLAG NEG 0) ;
  3498. QUITTER SECANTI ;
  3499. FINSI ;
  3500. I = 0 ;
  3501. F1 IFLAG1 = QUQU TAB_1 X1 ;
  3502. F2 IFLAG2 = QUQU TAB_1 X2 ;
  3503. *MESS ' F1 = ' F1 ;
  3504. *MESS ' F2 = ' F2 ;
  3505. XPREC = 0. ;
  3506. REPETER BOUC4(NMAX) ;
  3507. SI (OU (X1 >EG 10.E10) (X2 >EG 10.E10)) ;
  3508. IFLAG = 1 ;
  3509. FINSI ;
  3510. SI (X1 &lt;EG X1MIN) ;
  3511. X1 = X1MIN ;
  3512. FINSI ;
  3513. SI (IFLAG NEG 0) ;
  3514. QUITTER SECANTI ;
  3515. FINSI ;
  3516. X3 = X2-(F2*(X1-X2)/(F1-F2)) ;
  3517. ERR = (ABS ((XPREC-X3)/X3))*100 ;
  3518. F3 IFLAG3 = QUQU TAB_1 X3 ;
  3519. * MESS ' F3 = ' F3 ;
  3520. SI ((ERR &lt;EG ERRMAX) ET (F3 &lt;EG 1.E-3)) ;
  3521. QUITTER SECANTI ;
  3522. FINSI ;
  3523. XPREC = X3 ;
  3524. I = I + 1 ;
  3525. SI ((F1*F3) < 0.) ;
  3526. SI ((F2*F3) < 0.) ;
  3527. A1 = ABS (F3-F1) ;
  3528. A2 = ABS (F3-F2) ;
  3529. SI (A1 > A2) ;
  3530. X1 = X3 ;
  3531. F1 = F3 ;
  3532. SINON ;
  3533. X2 = X3 ;
  3534. F2 = F3 ;
  3535. FINSI ;
  3536. SINON ;
  3537. X2 = X3 ;
  3538. F2 = F3 ;
  3539. FINSI ;
  3540. SINON ;
  3541. SI ((F2*F3) > 0.) ;
  3542. A1 = ABS (F3-F1) ;
  3543. A2 = ABS (F3-F2) ;
  3544. SI (A1 > A2) ;
  3545. X1 = X3 ;
  3546. F1 = F3 ;
  3547. SINON ;
  3548. X2 = X3 ;
  3549. F2 = F3 ;
  3550. FINSI ;
  3551. SINON ;
  3552. X1 = X3 ;
  3553. F1 = F3 ;
  3554. FINSI ;
  3555. FINSI ;
  3556. FIN BOUC4 ;
  3557. *MESS ' X3 = ' X3 ;
  3558. FINPROC X3 ERR IFLAG ;
  3559. *_____________________________________________________________________________
  3560. *
  3561. **** @CELAT94
  3562. DEBPROC @CELAT94 TAB_1*TABLE ;
  3563. *
  3564. * --- entrees
  3565. *
  3566. NIVEAU = TAB_1.'NIVEAU';
  3567. SI (NIVEAU >EG 4);
  3568. MESS '---------------> calling @CELAT94';
  3569. FINSI ;
  3570.  
  3571. PROP_PHY TAB_1 ;
  3572. *
  3573. NORADICI = 0 ;
  3574. *DQ = 2.E3 ;
  3575. DQ = 2.E6 ;
  3576. Q1 = 0. ;
  3577. *Q1 = 20.E6 ;
  3578. REPETER BOUC2 ;
  3579. * MESS '---> BOUC2 ' ;
  3580. QQ = Q1 ;
  3581. IFLAG = 0 ;
  3582. QQ = QQ + DQ ;
  3583. FQ IFLAG = QUQU TAB_1 QQ ;
  3584. * MESS 'FQ =' FQ ;
  3585. * MESS '--------------------------IFLAG =' IFLAG ;
  3586. REPETER BOUC1 ;
  3587. * MESS '--> BOUC1 ' ;
  3588. SI (IFLAG &lt;EG 0) ;
  3589. QUITTER BOUC1 ;
  3590. FINSI ;
  3591. IFLAG = 0 ;
  3592. QQ = QQ + DQ ;
  3593. FQ IFLAG = QUQU TAB_1 QQ ;
  3594. FIN BOUC1 ;
  3595. SI (FQ >EG 0.) ;
  3596. QUITTER BOUC2 ;
  3597. SINON ;
  3598. SI (DQ < 1.E-2) ;
  3599. MESS '---> QUQU HAS NO ZERO ' ;
  3600. NORADICI = 1 ;
  3601. QUITTER BOUC2 ;
  3602. FINSI ;
  3603. Q1 = QQ - DQ ;
  3604. DQ = DQ / 2. ;
  3605. * MESS ' --------QQ = ' QQ ;
  3606. * MESS ' --------Q1 = ' Q1 ;
  3607. * MESS ' FQ = ' FQ ;
  3608. FINSI ;
  3609. FIN BOUC2 ;
  3610. *
  3611. *MESS '--->BOUC3' ;
  3612. *MESS ' **************************** ' ;
  3613. *MESS ' **************************** ' ;
  3614. *MESS ' **************************** ' ;
  3615. *MESS ' **************************** ' ;
  3616. *MESS ' **************************** ' ;
  3617. Q1 = QQ ;
  3618. Q1MIN = Q1 ;
  3619. Q2 = QQ + DQ ;
  3620. *MESS 'Q1 ='Q1 ;
  3621. *MESS 'Q1MIN =' Q1MIN ;
  3622. *MESS 'Q2 =' Q2 ;
  3623. *MESS 'DQ =' DQ ;
  3624. *MESS 'NORADICI =' NORADICI ;
  3625. REPETER BOUC3 ;
  3626. SI (NORADICI EGA 1) ;
  3627. QUITTER BOUC3 ;
  3628. FINSI ;
  3629. IFLAG = 0 ;
  3630. ERRMAX = 0.00001 ;
  3631. SI (OU (Q1 >EG 10.E10) (Q2 >EG 10.E10)) ;
  3632. MESS ' WARNING Q1 OR Q2 EXCEEDED MAXIMUM VALUE ' ;
  3633. QUITTER BOUC3 ;
  3634. FINSI ;
  3635. QCAL ERR IFLAG = SECANTI TAB_1 Q1 Q2 Q1MIN ERRMAX 500 ;
  3636. SI (IFLAG NEG 0) ;
  3637. MESS ' PARAMETER PROBLEM IN TEST ' ;
  3638. IFLAG = 0 ;
  3639. FINSI ;
  3640. SI (QCAL EGA 0.) ;
  3641. QUITTER BOUC3 ;
  3642. FINSI ;
  3643. QUITTER BOUC3 ;
  3644. FIN BOUC3 ;
  3645. *
  3646. MESS 'CELATA94 CRITICAL HEAT FLUX (W/m2) : 'QCAL ;
  3647. *
  3648. QCHFW = QCAL ;
  3649. DELTA = 0. ;
  3650. UB = 0. ;
  3651. UBL = 0. ;
  3652. BLB = 0. ;
  3653. Q1 = 0. ;
  3654. Q2 = 0. ;
  3655. QCAL = 0. ;
  3656. *
  3657. TAB_1.CHF = QCHFW ;
  3658. SI (NIVEAU >EG 4);
  3659. MESS '---------------> exiting @CELAT94';
  3660. FINSI ;
  3661. *FINPROC QCHFW ;
  3662. FINPROC ;
  3663. **** @CERI
  3664. DEBPROC @CERI P_1*POINT P_2*POINT P_3*POINT R_1*FLOTTANT ;
  3665. X_1 = COOR 1 P_1 ;
  3666. Y_1 = COOR 2 P_1 ;
  3667. X_2 = COOR 1 P_2 ;
  3668. Y_2 = COOR 2 P_2 ;
  3669. X_3 = COOR 1 P_3 ;
  3670. Y_3 = COOR 2 P_3 ;
  3671. X_I = (X_1 + X_2 ) / 2. ;
  3672. Y_I = (Y_1 + Y_2 ) / 2. ;
  3673. A_1 = (( X_1 - X_2 ) ** 2 ) + (( Y_1 - Y_2 ) ** 2 ) / 4. ;
  3674. R_12 = R_1 ** 2 ;
  3675. REPETER BLO1 1 ;
  3676. SI ( A_1 EGA R_12 1.E-6 ) ;
  3677. PS_1 = X_I Y_I ;
  3678. P_4 = PS_1 PLUS (( Y_1 - Y_I) ( X_I - X_1)) ;
  3679. X_4 = COOR 1 P_4 ;
  3680. Y_4 = COOR 2 P_4 ;
  3681. PSCAL_1 = ((X_I - X_4) * (X_I - X_3)) + ((Y_I - Y_4) * (Y_I - Y_3)) ;
  3682. SI (PSCAL_1 > 0. ) ;
  3683. P_4 = PS_1 MOIN (( Y_1 - Y_I) ( X_I - X_1)) ;
  3684. FINSI ;
  3685. C_ERC1 = (CERC P_1 PS_1 P_4) ET (CERC P_4 PS_1 P_2);
  3686. QUITTER BLO1 ;
  3687. FINSI ;
  3688.  
  3689. SI ( ( X_1 - X_2 ) NEG 0. 1.E-6) ;
  3690.  
  3691. B_1 = (( Y_1 - Y_2 ) ** 2 ) / (( X_1 - X_2 ) ** 2 ) + 1. ;
  3692. SI ( A_1 < R_12) ;
  3693.  
  3694. YS_1 = Y_I + (((R_12 - A_1) / B_1) ** 0.5 ) ;
  3695. XS_1 = X_I - ((YS_1 - Y_I)*(Y_1 - Y_2 )/(X_1 - X_2 )) ;
  3696. PS_1 = XS_1 YS_1 ;
  3697. PSCAL_1 = ((X_I - XS_1) * (X_I - X_3)) + ((Y_I - YS_1) * (Y_I - Y_3)) ;
  3698. SI (PSCAL_1 < 0. ) ;
  3699. YS_2 = Y_I - (((R_12 - A_1) / B_1) ** 0.5 ) ;
  3700. XS_2 = X_I - ((YS_2 - Y_I)*(Y_1 - Y_2 )/(X_1 - X_2 )) ;
  3701. PS_1 = XS_2 YS_2 ;
  3702. FINSI ;
  3703. C_ERC1 = CERC P_1 PS_1 P_2 ;
  3704. SINON ;
  3705.  
  3706. ERRE '>>@CERI>> DISTANCE ENTRE LES 2 POINTS SUPERIEUR AU DIAMETRE ' ;
  3707. FINSI ;
  3708.  
  3709. SINON ;
  3710. B_1 = (( Y_1 - Y_2 ) ** 2 ) + 1. ;
  3711. R_12 = R_1 ** 2 ;
  3712. YS_1 = Y_I + (((R_12 ) / B_1) ** 0.5 ) ;
  3713. XS_1 = X_I - ((YS_1 - Y_I)*(Y_2 - Y_1 )) ;
  3714. PS_1 = XS_1 YS_1 ;
  3715. PSCAL_1 = ((X_I - XS_1) * (X_I - X_3)) + ((Y_I - YS_1) * (Y_I - Y_3)) ;
  3716. SI (PSCAL_1 < 0. ) ;
  3717. YS_2 = Y_I - (((R_12 ) / B_1) ** 0.5) ;
  3718. XS_2 = X_I - ((YS_2 - Y_I)*(Y_2 - Y_1 )) ;
  3719. PS_1 = XS_2 YS_2 ;
  3720. FINSI ;
  3721. C_ERC1 = CERC P_1 PS_1 P_2 ;
  3722. FINSI ;
  3723. FIN BLO1 ;
  3724. FINPROC C_ERC1 PS_1 ;
  3725.  
  3726.  
  3727. *-----------------------------------------------------------------------
  3728. * Procedure CFLUXTOT
  3729. *-----------------------------------------------------------------------
  3730. DEBPROC CFLUXTOT TAB1*TABLE;
  3731. *
  3732. ***********************************************************************
  3733. * CFLUXTOT developpee par Nicolas URAGO (avr-sept 1994) *
  3734. * largement revisitee par Jacques SCHLOSSER et Alain MOAL (aout 1995) *
  3735. ***********************************************************************
  3736. ******* ATTENTION --> Cette procedure ne tourne qu'en 3D et ne peut
  3737. * traiter que des cas de limiteurs plancher car
  3738. * Z (point tangent) = Z (centre du plasma)
  3739. *
  3740. MESS '---------------------------------> calling CFLUXTOT';
  3741. *
  3742. *-------------------- VARIABLES D'ENTREE
  3743. LPAT1 = TAB1.LFLUX_EXTE ;
  3744. GRP1 = TAB1.GRAND_RAYON ;
  3745. IMESS = TAB1.'NIVEAU' ;
  3746. PTG = TAB1.'PT_TGPLASMA';
  3747. MODEL0 = TAB1.'MODELF' ;
  3748. LAMBQ = TAB1.LAMDAQ ;
  3749. LISFLU = TAB1.LIS_FLUX ;
  3750. OEIL0 = TAB1.VIEW_P ;
  3751. *
  3752. SI (EXISTE TAB1 ANGLE_DEC) ;
  3753. PSI = TAB1.ANGLE_DEC ;
  3754. SINON;
  3755. PSI = 0.0 ;
  3756. FINSI;
  3757. *---------------------------------------
  3758. *
  3759. *---- On calcule pour chaque point de LPAT1, les coordonnees
  3760. *---- de son'centre plasma'.
  3761. XP1 = COOR 1 LPAT1 ;
  3762. YP1 = COOR 2 LPAT1 ;
  3763. ZP1 = COOR 3 LPAT1 ;
  3764. GRAYP1 = (XP1**2 + (YP1**2))**0.5 ;
  3765. XCP1 = XP1 * GRP1 / GRAYP1 ;
  3766. YCP1 = YP1 * GRP1 / GRAYP1 ;
  3767. *
  3768. AUX1 = ((XCP1 - XP1)**2 + ((YCP1 - YP1)**2))**0.5;
  3769. BETA1 = ATG (AUX1/ZP1) ;
  3770. ALPHA2 = ATG YCP1 XCP1 ;
  3771. *
  3772. *---- le vecteur tangent aux lignes de champ B est orthogonal
  3773. *---- a V = P1CP1
  3774. VX1 = XCP1 - XP1 ;
  3775. VY1 = YCP1 - YP1 ;
  3776. VZ1 = ZP1 * -1. ;
  3777. *
  3778. *---- B appartient au plan defini par les vecteurs K (0, 0, 1) et U
  3779. *UX1 = SIN (PSI + ALPHA2) ;
  3780. *UY1 = (COS (PSI + ALPHA2)) * -1. ;
  3781. *UZ1 = UX1 * 0. ;
  3782. *
  3783. UX1 = SIN (PSI - ALPHA2) ;
  3784. UY1 = COS (PSI - ALPHA2) ;
  3785. UZ1 = UX1 * 0. ;
  3786. *
  3787. *---- calcul de B
  3788. BZ = ((VZ1*UX1)**2 + ((VZ1*UY1)**2)) / ((VX1*UX1 + (VY1*UY1))**2) + 1. ;
  3789. BZ = BZ**(-0.5) * -1.;
  3790. BY = BZ * (VZ1*UY1) /(VX1*UX1 + (VY1*UY1)) * -1. ;
  3791. BX = BY * UX1 / UY1 ;
  3792. *
  3793. *---- Calcul du produit scalaire : VECTEUR TANGENT . NORMALE
  3794. NX NY NZ = @VNORM3D (EXTR MODEL0 'MAIL') LPAT1 IMESS ;
  3795. COS_BN = ABS ((BX*NX) + (BY*NY) + (BZ*NZ)) ;
  3796. *
  3797. *---- Coordonnees du point de tangence
  3798. XREF1 = COOR 1 PTG ;
  3799. YREF1 = COOR 2 PTG ;
  3800. ZREF1 = COOR 3 PTG ;
  3801. *
  3802. *---- Centre du plasma au dessus du point de tangence
  3803. XCREF1 = XREF1 * GRP1 / ((XREF1**2 + (YREF1**2))**0.5);
  3804. YCREF1 = YREF1 * GRP1 / ((XREF1**2 + (YREF1**2))**0.5);
  3805. *
  3806. *---- DREF1 est le petit rayon du plasma
  3807. DREF1 = (((XREF1-XCREF1)**2) + ((YREF1-YCREF1)**2) + (ZREF1**2))**.5;
  3808. DIST1 = (((XP1 - XCP1)**2) + ((YP1 - YCP1)**2) + (ZP1**2))**.5;
  3809. *
  3810. *---- Distance a la DSMF
  3811. LDEC1 = DIST1 - DREF1 ;
  3812. *
  3813. *---- Calcul du profil de flux
  3814. VPAT1 = COS_BN * (EXP (LDEC1/(-1.*LAMBQ))) ;
  3815. VFP1 = FLUX MODEL0 VPAT1 ;
  3816. *
  3817. *---- Visualisations
  3818. ARET0 = ARETE LPAT1 ;
  3819. TITRE 'CFLUXTOT : B.N = COSINUS OF THE INCIDENCE ANGLE';
  3820. TRAC OEIL0 COS_BN LPAT1 ARET0;
  3821. TITRE 'CFLUXTOT : TANGENT VECTOR TO THE MAGNETIC LINE';
  3822. VB = @CVECT BX BY BZ LPAT1 VERT;
  3823. TRAC OEIL0 VB LPAT1 ;
  3824. TITRE 'CFLUXTOT : DISTANCE TO THE LCFS' ;
  3825. TRAC OEIL0 LDEC1 LPAT1 ARET0;
  3826. TITRE 'CFLUXTOT : PROFILE OF THE INCIDENT FLUX' ;
  3827. TRAC OEIL0 VPAT1 LPAT1 ARET0;
  3828. *
  3829. *-------------------- VARIABLES EN SORTIE
  3830. *---- flux moyen et puissance
  3831. TAB1.V_SOM1 = (EXTR LISFLU (DIME LISFLU)) * (MAXI (RESU VFP1));
  3832. TAB1.V_FACFM2 = (MAXI (RESU VFP1)) / (MESU LPAT1) ;
  3833. *-----------------------------------------
  3834. *
  3835. MESS '---------------------------------> exiting CFLUXTOT';
  3836. FINPROC VPAT1 ;
  3837.  
  3838.  
  3839.  
  3840.  
  3841.  
  3842. **** @CFPFLU
  3843.  
  3844. DEBPROC @CFPFLU TAB1*TABLE ;
  3845. *
  3846. **************************************************************
  3847. * Procedure de calcul du profil du depot de puissance sur un *
  3848. * objet avec la configuration magnetique de JET. *
  3849. * Alain MOAL (Janvier - Avril 2001) *
  3850. **************************************************************
  3851. * Modif : *
  3852. * 08/11/01 (A.MOAL) : nouveau nom (JETFLU devient CFPFLU) *
  3853. * 08/11/01 (A.MOAL) : calcul de la puissance reelle deposee *
  3854. * 23/11/01 (A.MOAL) : trace de dpsi sur le maillage *
  3855. * 06/12/01 (A.MOAL) : indicateur du passage dans cfpflu *
  3856. * 27/01/04 (A.MOAL) : suppression de l'indicateur <CFPFLU *
  3857. **************************************************************
  3858. *
  3859. MESS '---------------------------------> calling @CFPFLU';
  3860. *
  3861. *---- Valeurs par defaut, verification des indices de la table
  3862. @VDEFJET TAB1 ;
  3863. *
  3864. *--------------- VARIABLES D'ENTREE :
  3865. MAIL0 = TAB1.<MAILLAGE ;
  3866. MMAIL0 = TAB1.MODELF ;
  3867. CONT0 = TAB1.LFLUX_EXTE ;
  3868. IMESS = TAB1.<IMESS ;
  3869. ITRAC = TAB1.<ITRAC ;
  3870. ITYPDEP = TAB1.<TYPE_DEPOT ;
  3871. SI (NON (EXISTE TAB1 <NXM)) ;
  3872. ICALNORM = VRAI ;
  3873. SINON ;
  3874. ICALNORM = FAUX ;
  3875. NXM = TAB1.<NXM ;
  3876. NYM = TAB1.<NYM ;
  3877. NZM = TAB1.<NZM ;
  3878. FINSI ;
  3879. SI ((VALEUR DIME) EGA 3) ;
  3880. OEIL0 = TAB1.VIEW_P ;
  3881. SINON ;
  3882. CONTDES0 = TAB1.LFLUX_EXTE_DESS ;
  3883. FINSI ;
  3884. ICALINCI = TAB1.<CALCUL_INCIDENCE ;
  3885. PUISTOT0 = TAB1.<PUISSANCE_TOTALE ;
  3886. *------------------------------------
  3887. *
  3888. *TAB1.<CFPFLU = VRAI ;
  3889. *
  3890. *---- lecture de la carte de champ magnetique dans un fichier
  3891. @LECTB TAB1 ;
  3892.  
  3893. *--- trace de dpsi sur le maillage
  3894. TAB1.<MAILLAGE_B = CONT0 ;
  3895. CHDPSI = @DPSI TAB1 ;
  3896. TITRE '@CFPFLU : DPSI ON THE MESH' ;
  3897. LISOV0 = PROG -0.66 -0.33 0. 1. 2. 3. ;
  3898. OPTI ISOV LIGNE ;
  3899. TRAC LISOV0 CHDPSI CONT0 ;
  3900. OPTI ISOV SURFACE ;
  3901. *
  3902. *---- lecture du flux normalise sur une ligne dans un fichier
  3903. @LECTF TAB1 ;
  3904. TITRE '@CFPFLU : MAGNETIC DOMAIN, AREA FOR NORMALIZED FLUX AND STUDIED OBJECT';
  3905. *TRAC (TAB1.<GRILLE_B ET TAB1.<MAILLAGE_FN ET MAIL0) ;
  3906. TRAC ((ENVE TAB1.<GRILLE_B) ET (CONT TAB1.<MAILLAGE_FN) ET (ENVE MAIL0));
  3907. *
  3908. *---- calcul du champ B sur la ligne de reference pour
  3909. *---- verification des angles d'incidences
  3910. SI (ICALINCI) ;
  3911. @VERANG TAB1 ;
  3912. FINSI ;
  3913.  
  3914. TAB1.<MAILLAGE_B = TAB1.<MAILLAGE_FN ;
  3915. BR BZ BPHI = @MAGNB TAB1 ;
  3916. *
  3917. *---- calcul du champ magnetique sur le maillage
  3918. TAB1.<MAILLAGE_B = MAIL0 ;
  3919. BR BZ BPHI = @MAGNB TAB1 ;
  3920.  
  3921. PHI = ATG (COOR 2 MAIL0) (COOR 1 MAIL0) ;
  3922. *AM*11/09/01*BXM = BR * (COS PHI) + (BPHI * (SIN PHI));
  3923. *AM*11/09/01*BYM = BR * (SIN PHI) - (BPHI * (COS PHI));
  3924. BXM = BR * (COS PHI) - (BPHI * (SIN PHI));
  3925. BYM = BR * (SIN PHI) + (BPHI * (COS PHI));
  3926. BZM = BZ ;
  3927. MENAGE ;
  3928. *
  3929. *---- calcul des normales a la surface calculees
  3930. *---- dans le repere du maillage
  3931. SI (ICALNORM) ;
  3932. NXM NYM NZM = @VNORM3D MAIL0 CONT0 ;
  3933. TAB1.<NXM = NXM ;
  3934. TAB1.<NYM = NYM ;
  3935. TAB1.<NZM = NZM ;
  3936. FINSI;
  3937. MENAGE ;
  3938. *
  3939. *---- calcul du produit scalaire et de l'angle d'incidence
  3940. B_NORM = ((BXM*BXM) + (BYM*BYM) + (BZM*BZM))**0.5 ;
  3941. VBVN = (ABS ((BXM*NXM) + (BYM*NYM) + (BZM*NZM))) / B_NORM;
  3942. ANGINCI = ATG ((1.-(VBVN**2))**0.5) VBVN ;
  3943. *
  3944. *---- vecteur champ magnetique et vecteur normal dans le repere
  3945. *---- du maillage en vue de la visualisation
  3946. VB1 = @CVECT BXM BYM BZM CONT0 VERT;
  3947. VN1 = @CVECT NXM NYM NZM CONT0 BLEU;
  3948. *
  3949. *---- dans le plan xy du repere du maillage
  3950. BETA2DXY = ATG (BYM*-1.) (BXM*-1.) ;
  3951. *---- dans le plan xz du repere du maillage
  3952. BETA2DXZ = ATG (BZM*-1.) (BXM*-1.) ;
  3953. *
  3954. *---- calcul de la densite de puissance recue par chaque point
  3955. VAR1 = @FLNORM TAB1 ;
  3956. *
  3957. *---- profil du flux pour une puissance de 1 MW deposee sur l'objet
  3958. *---- (flux parallele ou perpendiculaire)
  3959. SI (ITYPDEP) ;
  3960. PROFIL0 = VAR1 * VBVN ;
  3961. SINON ;
  3962. PROFIL0 = VAR1 * ((1. - (VBVN*VBVN)) ** .5) ;
  3963. FINSI ;
  3964. *
  3965. *---- integration du flux sur la surface
  3966. PROCONT0 = NOMC SCAL (FLUX MMAIL0 PROFIL0) ;
  3967. *
  3968. *---- calcul du flux moyen
  3969. PROMOY = (MAXI (RESU PROCONT0)) / (MESU CONT0) ;
  3970. *
  3971. *---- flux reel deposee pour une puissance donnee en MW
  3972. PROFIL1 = PROFIL0 * PUISTOT0 ;
  3973. *
  3974. *---- traces en 3D
  3975. SI (((VALEUR DIME) EGA 3) ET ITRAC) ;
  3976. SI (EGA (VALEUR ELEM) 'CUB8') ;
  3977. ARET1 = ARETE CONT0 ;
  3978. SINON ;
  3979. ARET1 = ARETE CONT0 40. ;
  3980. FINSI ;
  3981. TITRE '@CFPFLU : MAGNETIC FIELD AND NORMAL VECTOR' ;
  3982. TRACE CACH OEIL0 (VB1 ET VN1) MAIL0 ;
  3983. TITRE '@CFPFLU : COSINUS OF THE ANGLE BETWEEN b AND n' ;
  3984. TRACE CACH OEIL0 20 VBVN CONT0 ARET1;
  3985. TITRE '@CFPFLU : 90 - ANGLE BETWEEN VECTORS B AND SURFACE (DEGREE)';
  3986. TRACE CACH OEIL0 20 (90. - ANGINCI) CONT0 ARET1;
  3987. TITRE '@CFPFLU : NORM OF THE MAGNETIC FIELD (TESLA)' ;
  3988. TRACE CACH OEIL0 20 B_NORM CONT0 ARET1 ;
  3989. * TITRE '@CFPFLU : flux0 * exp (- delta / lamdaq)' ;
  3990. * TRACE CACH OEIL0 20 VAR1 CONT0 ARET1;
  3991. TITRE '@CFPFLU : INCIDENT HEAT FLUX FOR 'PUISTOT0' MW' ;
  3992. * TRACE CACH OEIL0 20 PROFIL0 CONT0 ARET1 ;
  3993. TRACE CACH OEIL0 20 PROFIL1 CONT0 ARET1 ;
  3994. FINSI ;
  3995.  
  3996. SI (IMESS >EG 2) ;
  3997. MESS '>>>> @CFPFLU : BXM '; MESS (MAXI BXM) (MINI BXM) ;
  3998. MESS '>>>> @CFPFLU : BYM '; MESS (MAXI BYM) (MINI BYM) ;
  3999. MESS '>>>> @CFPFLU : BZM '; MESS (MAXI BZM) (MINI BZM) ;
  4000. MESS '>>>> @CFPFLU : PROFIL0 ';
  4001. MESS (MAXI PROFIL0) (MINI PROFIL0) ;
  4002. MESS '>>>> @CFPFLU : PROFIL1 ';
  4003. MESS (MAXI PROFIL1) (MINI PROFIL1) ;
  4004. MESS '>>>> @CFPFLU : VAR1 '; MESS (MAXI VAR1) (MINI VAR1) ;
  4005. MESS '>>>> @CFPFLU : ANGINCI ';
  4006. MESS (MAXI ANGINCI) (MINI ANGINCI) ;
  4007. FINSI ;
  4008. SI (IMESS >EG 3) ;
  4009. MESS '>>>> @CFPFLU : BXM '; LIST BXM ;
  4010. MESS '>>>> @CFPFLU : BYM '; LIST BYM ;
  4011. MESS '>>>> @CFPFLU : BZM '; LIST BZM ;
  4012. MESS '>>>> @CFPFLU : VBVN '; LIST VBVN ;
  4013. MESS '>>>> @CFPFLU : BETA2DXY '; LIST BETA2DXY ;
  4014. MESS '>>>> @CFPFLU : BETA2DXZ '; LIST BETA2DXZ ;
  4015. MESS '>>>> @CFPFLU : ANGINCI '; LIST ANGINCI ;
  4016. MESS '>>>> @CFPFLU : PROFIL0 '; LIST PROFIL0 ;
  4017. MESS '>>>> @CFPFLU : PROFIL1 '; LIST PROFIL1 ;
  4018. FINSI ;
  4019. *
  4020. *--------------- VARIABLES DE SORTIE :
  4021. TAB1.V_FACFM2 = PROMOY ;
  4022. TAB1.<ANGINCI = ANGINCI ;
  4023. TAB1.<VBVN = VBVN ;
  4024. *TAB1.<CFPFLU = FAUX ;
  4025. *-------------------------------------
  4026. MESS '---------------------------------> exiting @CFPFLU';
  4027. FINPROC PROFIL1 ;
  4028.  
  4029. **** @CHAMB
  4030. DEBPROC @CHAMB TAB1*TABLE XG1*CHPOINT YG1*CHPOINT ZG1*CHPOINT ISHIFT*LOGIQUE IRIPPLE*LOGIQUE ;
  4031. *
  4032. ***********************************************************
  4033. * Procedure de calcul du champ magnetique en chaque point *
  4034. * en utilisant le modele Seigneur-Hertout de ripple avec *
  4035. * prise en compte du shift de Shafranov. *
  4036. * Alain MOAL (juin 1995) *
  4037. ***********************************************************
  4038. *123456789012345678901234567890123456789012345678901234567890123456789012
  4039. * 1 2 3 4 5 6 7
  4040. ***********************************************************
  4041. *
  4042. *MESS '---------------------------------> calling @CHAMB';
  4043. *
  4044. *--------------- VARIABLES D'ENTREE :
  4045. RP = TAB1.<RP ;
  4046. HP = TAB1.<HP ;
  4047. RHO0 = TAB1.<RHO0 ;
  4048. THETA0 = TAB1.<THETA0 ;
  4049. ANGPHI0 = TAB1.<ANGPHI0 ;
  4050. RR = TAB1.<RR ;
  4051. LAMB = TAB1.<LAMB ;
  4052. IPLASMA = TAB1.<IPLASMA ;
  4053. COEFA = TAB1.<COEFA ;
  4054. COEFB = TAB1.<COEFB ;
  4055. COEFC = TAB1.<COEFC ;
  4056. EPS = TAB1.<EPS ;
  4057. NBOB = TAB1.<NBOB ;
  4058. NSPI = TAB1.<NSPI ;
  4059. INTENS = TAB1.<INTENS ;
  4060. IMESS = TAB1.<IMESS ;
  4061. ICHAMP = TAB1.<MODEL_CHAMP ;
  4062. *------------------------------------
  4063. *
  4064. PI = 3.141592 ;
  4065. MU0 = PI * 4.E-7 ;
  4066. *
  4067. *---- Coordonnees de chaque point dans le repere du plasma
  4068. RHOP THETAP PHIP = @CRGTC XG1 YG1 ZG1 RP HP ;
  4069. *
  4070. *---- Masque delimitant le domaine de validite du modele de ripple
  4071. *attention domaine de validite etendu de 110 a 180 par
  4072. *E.COSTA/E.TSITRONE le 02/06/97
  4073. *MASK0 = (ABS THETAP) MASQUE INFERIEUR 110. ;
  4074. MASK0 = (ABS THETAP) MASQUE INFERIEUR 181. ;
  4075.  
  4076. *
  4077. *SI (NON ISHIFT) ;
  4078. * LAMB = -1. ;
  4079. *FINSI ;
  4080. *
  4081. *---- Calcul dans le repere du plasma des composantes du champ
  4082. *---- poloidal induit par le courant circulant dans le plasma
  4083. AUX0 = -1. * MU0 * IPLASMA / (2. * PI) ;
  4084. *
  4085. SI (EGA ICHAMP 'SEIGNEUR') ;
  4086. BPOL_RHO = (RHOP ** -2) * (RHO0**2) - 1. ;
  4087. BPOL_RHO = BPOL_RHO * (LAMB + 0.5) + (LOG (RHOP / RHO0)) ;
  4088. BPOL_RHO = BPOL_RHO * (SIN THETAP) * AUX0 / (2. * RP) ;
  4089. *
  4090. BPOL_THE = ((RHOP ** -2) * (RHO0**2)) + 1. ;
  4091. BPOL_THE = BPOL_THE * (LAMB + 0.5) - 1. + (LOG (RHOP / RHO0));
  4092. BPOL_THE = BPOL_THE * RHOP * (COS THETAP) / (2. * RP) + 1. ;
  4093. BPOL_THE = BPOL_THE * (RHOP ** -1) * AUX0 ;
  4094. FINSI ;
  4095. *
  4096. SI (EGA ICHAMP 'SHAFRANOV') ;
  4097. * ---- cette formulation a ma preference, les 2 autres semblent
  4098. * douteuses (A.MOAL)
  4099. BPOL_RHO = ((RHOP ** -2) * (RHO0**2) - 1.) * -1. ;
  4100. BPOL_RHO = BPOL_RHO * (LAMB + 0.5) + (LOG (RHOP / RHO0)) ;
  4101. BPOL_RHO = BPOL_RHO * (SIN THETAP) * AUX0 / (2. * RP) ;
  4102. *
  4103. BPOL_THE = ((RHOP ** -2) * (RHO0**2)) + 1. ;
  4104. BPOL_THE = BPOL_THE * (LAMB + 0.5) - 1. + (LOG (RHOP / RHO0));
  4105. BPOL_THE = BPOL_THE * RHOP * (COS THETAP) / (2. * RP) + 1. ;
  4106. BPOL_THE = BPOL_THE * (RHOP ** -1) * AUX0 ;
  4107. FINSI ;
  4108. *
  4109. SI (EGA ICHAMP 'ARTSIMOVICH') ;
  4110. BPOL_RHO = ((RHOP ** -2) * (RHO0**2) - 1.) * -1. ;
  4111. BPOL_RHO = BPOL_RHO * (LAMB + 0.5) + (LOG (RHOP / RHO0)) ;
  4112. BPOL_RHO = BPOL_RHO * (SIN THETAP) * AUX0 / (2. * RP) ;
  4113. *
  4114. BPOL_THE = ((RHOP ** -2) * (RHO0**2)) + 1. ;
  4115. BPOL_THE = BPOL_THE * (LAMB + 0.5) - 1. + (LOG (RHOP / RHO0));
  4116. BPOL_THE = BPOL_THE * (COS THETAP) / 2. + 1. ;
  4117. BPOL_THE = BPOL_THE * AUX0 / RP ;
  4118. FINSI ;
  4119. *
  4120. SI (NON ISHIFT) ;
  4121. BPOL_THE = ((RHOP * 2. * PI / (MU0 * IPLASMA))**(-1))*(-1.) ;
  4122. BPOL_RHO = BPOL_THE * 0. ;
  4123. FINSI ;
  4124. *
  4125. BPOL_PHI = RHOP * 0. ;
  4126. *
  4127. *---- Passage dans la base cartesienne de la machine
  4128. BXPOL BYPOL BZPOL = @CBTGV BPOL_RHO BPOL_THE BPOL_PHI THETAP PHIP ;
  4129. *
  4130. *---- Coordonnees de chaque point dans le "repere du ripple"
  4131. RHOR THETAR PHIR = @CRGTC XG1 YG1 ZG1 RR 0. ;
  4132. *
  4133. SI IRIPPLE ;
  4134. * ---- Calcul dans le repere adapte au calcul du ripple du champ
  4135. * ---- cree par les bobines toroidales
  4136. *
  4137. * ---- 1) calcul de la coordonnee radiale dans le plan meridien Phi=0
  4138. * ---- de la ligne de champ consideree par une methode de point fixe
  4139. RHO_OLD = RHOR ;
  4140. KAUX = (EXP(THETAR**2 * -1. * COEFC)) * ((COS((PHIR + ANGPHI0) * NBOB)) * -1. + 1.) * COEFA ;
  4141. I = 0 ;
  4142. IMAX = 50 ;
  4143. REPETER BOUCLE IMAX ;
  4144. I = I + 1;
  4145. RHO_NEW = RHOR + (KAUX * (EXP(RHO_OLD * COEFB))) ;
  4146. * MESS ' ITERATIONS NUMBER : ' I ;
  4147. * MESS (maxi RHO_NEW ) ;
  4148. SI ((MAXI (ABS((RHO_NEW - RHO_OLD) / RHO_NEW))) &lt;EG EPS) ;
  4149. * MESS ' ITERATIONS NUMBER : ' I ;
  4150. QUITTER BOUCLE ;
  4151. FINSI ;
  4152. RHO_OLD = RHO_NEW ;
  4153. FIN BOUCLE ;
  4154. SI (I >EG IMAX) ;
  4155. MESS '>>> @CHAMB : NO CONVERGENCE OF THE ITERATIVE METHOD !';
  4156. MESS '>>> PROPOSED SOLUTIONS : ' ;
  4157. MESS '>>> 1) INCREASE THE CONVERGENCE CRITERIUM (TAB1.<EPS) ';
  4158. MESS '>>> 2) CHECK YOU ARE WITHIN MODEL VALIDITY DOMAIN ';
  4159. MESS '>>> 3) ASK FOR THE PROCEDURE CONCEPTOR ';
  4160. *EC* ERRE ' >>> STOP IN @CHAMB';
  4161. ERRE ' >>> STOP IN @CHAMB';
  4162. FINSI ;
  4163. RHOMER = RHO_NEW ;
  4164. *
  4165. * ---- 2) composantes du champ (modele Hertout-Seigneur)
  4166. DRHOMER = (EXP(RHOMER * COEFB)) * (EXP(THETAR**2 * COEFC * -1.)) * COEFA ;
  4167. FINSI ;
  4168. RAUX1 = RHOR * (COS THETAR) + RR ;
  4169. *
  4170. *---- champ toroidal moyen sur le cercle de rayon Rr
  4171. BPHI0 = -1. * MU0 * INTENS * NBOB * NSPI / (2. * PI * RR) ;
  4172. *
  4173. *---- champ toroidal moyen sur le cercle de rayon
  4174. * (Rr + Rhor * cos Thetar)
  4175. BTPHI0 = (RAUX1 ** -1.) * BPHI0 * RR ;
  4176. *
  4177. SI IRIPPLE ;
  4178.  
  4179. *EC mai 1997* BTOR_PHI = RHOR / (RAUX1*RHOR) + COEFB ;
  4180. *CB fev 2015* BTOR_PHI = RR / (RAUX1*RHOR) + COEFB ;
  4181. *CB, pour prendre l'inverse du CHPOINT, utilisation de '**' (-1)
  4182. BTOR_PHI = RR * ((RAUX1*RHOR)**(-1)) + COEFB ;
  4183.  
  4184. *AM* BTOR_PHI = ((RHOR * RAUX1)**-1) * (RAUX1 * -1. + (2.*RR)) + COEFB;
  4185.  
  4186. BTOR_PHI = BTOR_PHI * (-1.) * DRHOMER * (COS((PHIR + ANGPHI0) * NBOB)) + 1. ;
  4187.  
  4188. BTOR_PHI = MASK0 * BTOR_PHI * BTPHI0 + ((1.-MASK0) * BTPHI0);
  4189. *
  4190.  
  4191. BTOR_RHO = MASK0 * (RAUX1 ** -1.) * DRHOMER * BTPHI0 * (SIN((PHIR + ANGPHI0) * NBOB)) * NBOB * (-1.) ;
  4192.  
  4193.  
  4194. *
  4195. BTOR_THE = RHOR * 0. ;
  4196. *
  4197. RHOMER = MASK0 * RHOMER + ((1.-MASK0) * RHOR) ;
  4198. SINON ;
  4199. BTOR_PHI = BTPHI0 ;
  4200. BTOR_RHO = RHOR * 0. ;
  4201. BTOR_THE = RHOR * 0. ;
  4202. RHOMER = RHOR ;
  4203. FINSI ;
  4204.  
  4205. *
  4206. *---- Passage dans la base cartesienne de la machine
  4207. BXTOR BYTOR BZTOR = @CBTGV BTOR_RHO BTOR_THE BTOR_PHI THETAR PHIR ;
  4208. *
  4209. *---- Normes du champ poloidal et du champ toroidal
  4210. N_BPOL = (BXPOL*BXPOL + (BYPOL*BYPOL) + (BZPOL*BZPOL))**0.5 ;
  4211. N_BTOR = (BXTOR*BXTOR + (BYTOR*BYTOR) + (BZTOR*BZTOR))**0.5 ;
  4212. *
  4213. *---- Facteur de securite
  4214. FSECU = (RHOP / (RHOP*(COS THETAP)+RP)) * (N_BTOR / N_BPOL) ;
  4215. *
  4216. *---- Champ total
  4217. SI (EXISTE TAB1 MOAL1) ;
  4218. BXPOL = BXPOL*0.;
  4219. BYPOL = BYPOL*0.;
  4220. BZPOL = BZPOL*0.;
  4221. FINSI ;
  4222. SI (EXISTE TAB1 MOAL2) ;
  4223. BXTOR = BXTOR*0.;
  4224. BYTOR = BYTOR*0.;
  4225. BZTOR = BZTOR*0.;
  4226. FINSI ;
  4227. BX = BXPOL + BXTOR ;
  4228. BY = BYPOL + BYTOR ;
  4229. BZ = BZPOL + BZTOR ;
  4230. *
  4231. *---- Messages de verification du calcul
  4232. SI (IMESS >EG 2) ;
  4233. MESS '>>>> @CHAMB ' ;
  4234. MESS 'max and min of the BPOL components in RP' ;
  4235. MESS (MAXI BPOL_RHO) (MINI BPOL_RHO) ;
  4236. MESS (MAXI BPOL_THE) (MINI BPOL_THE) ;
  4237. MESS (MAXI BPOL_PHI) (MINI BPOL_PHI) ;
  4238. MESS 'max and min of the BTOR components in RR' ;
  4239. MESS (MAXI BTOR_RHO) (MINI BTOR_RHO) ;
  4240. MESS (MAXI BTOR_THE) (MINI BTOR_THE) ;
  4241. MESS (MAXI BTOR_PHI) (MINI BTOR_PHI) ;
  4242. MESS 'max and min of the BPOL components' ;
  4243. MESS (MAXI BXPOL) (MINI BXPOL) ;
  4244. MESS (MAXI BYPOL) (MINI BYPOL) ;
  4245. MESS (MAXI BZPOL) (MINI BZPOL) ;
  4246. MESS 'max and min of the BTOR components' ;
  4247. MESS (MAXI BXTOR) (MINI BXTOR) ;
  4248. MESS (MAXI BYTOR) (MINI BYTOR) ;
  4249. MESS (MAXI BZTOR) (MINI BZTOR) ;
  4250. MESS 'max and min of Rho, Theta, Phi in RP';
  4251. MESS (MAXI RHOP) (MINI RHOP) ;
  4252. MESS (MAXI THETAP) (MINI THETAP) ;
  4253. MESS (MAXI PHIP) (MINI PHIP) ;
  4254. MESS 'max and min of X, Y, Z ';
  4255. MESS (MAXI XG1) (MINI XG1) ;
  4256. MESS (MAXI YG1) (MINI YG1) ;
  4257. MESS (MAXI ZG1) (MINI ZG1) ;
  4258. FINSI ;
  4259. SI (IMESS >EG 3) ;
  4260. MESS '>>>> @CHAMB : BPOL_RHO in RP '; LIST BPOL_RHO;
  4261. MESS '>>>> @CHAMB : BPOL_THE in RP '; LIST BPOL_THE;
  4262. MESS '>>>> @CHAMB : BPOL_PHI in RP '; LIST BPOL_PHI;
  4263. MESS '>>>> @CHAMB : BTOR_RHO in RR '; LIST BTOR_RHO;
  4264. MESS '>>>> @CHAMB : BTOR_THE in RR '; LIST BTOR_THE;
  4265. MESS '>>>> @CHAMB : BTOR_PHI in RR '; LIST BTOR_PHI;
  4266. MESS '>>>> @CHAMB : BXPOL '; LIST BXPOL;
  4267. MESS '>>>> @CHAMB : BYPOL '; LIST BYPOL;
  4268. MESS '>>>> @CHAMB : BZPOL '; LIST BZPOL;
  4269. MESS '>>>> @CHAMB : BXTOR '; LIST BXTOR;
  4270. MESS '>>>> @CHAMB : BYTOR '; LIST BYTOR;
  4271. MESS '>>>> @CHAMB : BZTOR '; LIST BZTOR;
  4272. MESS '>>>> @CHAMB : BTOR_THE in RR '; LIST BTOR_THE;
  4273. MESS '>>>> @CHAMB : BTOR_PHI in RR '; LIST BTOR_PHI;
  4274. MESS '>>>> @CHAMB : X '; LIST XG1;
  4275. MESS '>>>> @CHAMB : Y '; LIST YG1;
  4276. MESS '>>>> @CHAMB : Z '; LIST ZG1;
  4277. MESS '>>>> @CHAMB : RHO in RP '; LIST RHOP;
  4278. MESS '>>>> @CHAMB : THETA in RP '; LIST THETAP;
  4279. MESS '>>>> @CHAMB : PHI in RP '; LIST PHIP;
  4280. MESS '>>>> @CHAMB : RHO in RR '; LIST RHOR;
  4281. MESS '>>>> @CHAMB : THETA in RR '; LIST THETAR;
  4282. MESS '>>>> @CHAMB : PHI in RR '; LIST PHIR;
  4283. MESS '>>>> @CHAMB : RHOMER '; LIST RHOMER ;
  4284. MESS '>>>> @CHAMB : BPHI0 ' ; LIST BPHI0 ;
  4285. FINSI ;
  4286. *
  4287. *MESS '---------------------------------> exiting @CHAMB';
  4288. *
  4289. *--------------- VARIABLES DE SORTIE :
  4290. TAB1.<RHOMER = RHOMER ;
  4291. TAB1.<BXPOL = BXPOL ;
  4292. TAB1.<BYPOL = BYPOL ;
  4293. TAB1.<BZPOL = BZPOL ;
  4294. TAB1.<BXTOR = BXTOR ;
  4295. TAB1.<BYTOR = BYTOR ;
  4296. TAB1.<BZTOR = BZTOR ;
  4297. *-------------------------------------
  4298. FINPROC BX BY BZ FSECU;
  4299.  
  4300. **** @CRLTC
  4301. DEBPROC @CRLTC TAB1*TABLE XM*CHPOINT YM*CHPOINT ZM*CHPOINT R*FLOTTANT ;
  4302. *
  4303. ***************************************************************
  4304. * Procedure de changement de repere, on passe des *
  4305. * coordonnees cartesiennes dans le repere de local de l'objet *
  4306. * XM YM ZM repere defini par TAB1.<RHO0, TAB1.<THETA0 et *
  4307. * TAB1.<RP aux coordonnees pseudo-toroidales defini par un *
  4308. * grand rayon donne R . Alain MOAL (mai 1995) *
  4309. ***************************************************************
  4310. *
  4311. *--------------- VARIABLES D'ENTREE :
  4312. RHO0 = TAB1.<RHO0 ;
  4313. THETA0 = TAB1.<THETA0 ;
  4314. RP = TAB1.<RP ;
  4315. *------------------------------------
  4316. *
  4317. CT0 = COS THETA0 ;
  4318. ST0 = SIN THETA0 ;
  4319. MST0 = ST0 * -1. ;
  4320. *
  4321. *---- 1) rotation d'angle THETA0 autour de l'axe X
  4322. X1 = XM ;
  4323. Y1 = (YM * CT0) + (ZM * ST0) ;
  4324. Z1 = (YM * MST0) + (ZM * CT0) ;
  4325. *
  4326. *---- 2) changement d'origine vers le centre du tore,
  4327. *---- rotation de 180 degres autour de l'axe Z2 pour
  4328. *---- retrouver le repere global puis calcul de PHI
  4329. X2 = X1 ;
  4330. Y2 = Y1 - (RHO0 * CT0 + RP) ;
  4331. Z2 = Z1 + (RHO0 * ST0) ;
  4332. *
  4333. X2 = X2 * -1. ;
  4334. Y2 = Y2 * -1. ;
  4335. PHI = ATG (X2 * -1.) Y2 ;
  4336. *
  4337. *---- 3) rotation d'angle PHI autour de l'axe Z2
  4338. CPHI = COS PHI ;
  4339. SPHI = SIN PHI ;
  4340. MSPHI = SPHI * -1. ;
  4341. X3 = (X2 * CPHI) + (Y2 * SPHI) ;
  4342. Y3 = (X2 * MSPHI) + (Y2 * CPHI) ;
  4343. Z3 = Z2 ;
  4344. *
  4345. *---- 4) changement d'origine vers le centre du nouveau repere
  4346. X4 = X3 ;
  4347. Y4 = Y3 - R ;
  4348. Z4 = Z3 ;
  4349. *
  4350. *---- calcul de RHO et THETA
  4351. RHO = ((Y4 * Y4) + (Z4 * Z4))**0.5 ;
  4352. THETA = ATG Z4 Y4 ;
  4353. *
  4354. MESS '>>>> @CRLTC : max and min of the angle PHI' ;
  4355. MESS (MAXI PHI) (MINI PHI) ;
  4356. *
  4357. FINPROC RHO THETA PHI ;
  4358. **** @CRTLC
  4359. DEBPROC @CRTLC R*FLOTTANT RHO*CHPOINT THETA*CHPOINT PHI*CHPOINT TAB1*TABLE ;
  4360. *
  4361. ***************************************************************
  4362. * Procedure de changement de repere, on passe des coordonnees *
  4363. * pseudo-toroidales centrees sur un grand rayon R aux *
  4364. * coordonnees cartesiennes dans le repere de la structure *
  4365. * modelisee. Alain MOAL (mai 1995) *
  4366. ***************************************************************
  4367. *
  4368. *--------------- VARIABLES D'ENTREE :
  4369. RHO0 = TAB1.<RHO0 ;
  4370. THETA0 = TAB1.<THETA0 ;
  4371. RP = TAB1.<RP ;
  4372. *------------------------------------
  4373. *
  4374. CT0 = COS THETA0 ;
  4375. ST0 = SIN THETA0 ;
  4376. MST0= ST0 * -1. ;
  4377. CPHI = COS PHI ;
  4378. SPHI = SIN PHI ;
  4379. MSPHI = SPHI * -1. ;
  4380. *
  4381. X4 = RHO * 0. ;
  4382. Y4 = RHO * (COS THETA) ;
  4383. Z4 = RHO * (SIN THETA) ;
  4384. *
  4385. *---- 1) changement d'origine vers le centre du tore
  4386. X3 = X4 ;
  4387. Y3 = Y4 + R ;
  4388. Z3 = Z4 ;
  4389. *
  4390. *---- 2) rotation d'angle - PHI autour de l'axe Z3
  4391. * puis rotation de - 180 degres autour de l'axe Z2
  4392. X2 = (X3 * CPHI) + (Y3 * MSPHI) ;
  4393. Y2 = (X3 * SPHI) + (Y3 * CPHI) ;
  4394. Z2 = Z3 ;
  4395. *
  4396. X2 = X2 * -1. ;
  4397. Y2 = Y2 * -1. ;
  4398. *
  4399. *---- 3) changement d'origine vers le centre d'objet
  4400. X1 = X2 ;
  4401. Y1 = Y2 + RP + (RHO0 * CT0) ;
  4402. Z1 = Z2 - (RHO0 * ST0) ;
  4403. *
  4404. *---- 4) rotation d'angle - THETA0 autour de l'axe X1
  4405. XP = X1 ;
  4406. YP = (Y1 * CT0) + (Z1 * MST0) ;
  4407. ZP = (Y1 * ST0) + (Z1 * CT0) ;
  4408. *
  4409. FINPROC XP YP ZP ;
  4410. **** @CRTTC
  4411. DEBPROC @CRTTC R1*FLOTTANT RHO1*CHPOINT THETA1*CHPOINT PHI1*CHPOINT R2*FLOTTANT ;
  4412. *
  4413. ***************************************************************
  4414. * Procedure de changement de repere. On passe d'un repere *
  4415. * pseudo-toroidal defini par son grand rayon R1 a un autre *
  4416. * repere pseudo-toroidal defini par son grand rayon R2. Ces *
  4417. * deux reperes ont la meme orientation toroidale: Phi1 = Phi2 *
  4418. * Alain MOAL (juin 1995) *
  4419. ***************************************************************
  4420. *
  4421. RHO2 = RHO1**2 + ((R1 - R2)**2) ;
  4422. RHO2 = RHO2 + (RHO1*(R1 - R2)*(COS THETA1)*2.) ;
  4423. RHO2 = RHO2**0.5 ;
  4424. *
  4425. AUX1 = RHO1 * (SIN THETA1) ;
  4426. AUX2 = RHO1 * (COS THETA1) - R2 + R1 ;
  4427. THETA2 = ATG AUX1 AUX2 ;
  4428. *
  4429. PHI2 = PHI1 ;
  4430. *
  4431. FINPROC RHO2 THETA2 PHI2 ;
  4432. **** @CRLMC
  4433. DEBPROC @CRLMC XL*CHPOINT YL*CHPOINT ZL*CHPOINT TAB1*TABLE ;
  4434. *
  4435. *******************************************************************
  4436. * Version amelioree de l'ancien @CRLMC rebaptise @ACRLM *
  4437. * Procedure de changement de repere. On passe du repere cartesien *
  4438. * local de l'objet modelise au repere cartesien du maillage. Le *
  4439. * point de tangence au plasma est l'origine du repere local et *
  4440. * l'axe Y est dirige vers le centre du plasma. En 3D, L'axe X du *
  4441. * repere local est dans la direction toroidale. *
  4442. * en 2D cas PHICONS l'axe Z du repere local est l'axe toroidal *
  4443. * en 2D cas THECONS l'axe x du repere local est l'axe toroidal *
  4444. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  4445. *******************************************************************
  4446. *
  4447. *--------------- VARIABLES D'ENTREE :
  4448. CP = TAB1.CENTRE_PLASMA ;
  4449. PTG = TAB1.PT_TGPLASMA ;
  4450. SI ((VALEUR DIME) EGA 2) ;
  4451. SI (EXISTE TAB1 <PLAN) ;
  4452. IPLAN = TAB1.<PLAN ;
  4453. SINON ;
  4454. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  4455. FINSI ;
  4456. SINON ;
  4457. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  4458. DIR1 = TAB1.<DIR_TOROIDAL ;
  4459. SINON ;
  4460. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  4461. FINSI ;
  4462. FINSI ;
  4463. *------------------------------------
  4464. *
  4465. SI ((VALEUR DIME) EGA 2) ;
  4466. VECT0 = CP MOINS PTG ;
  4467. VX VY = COOR VECT0 ;
  4468. *
  4469. * ---- calcul de l'angle de rotation dans le plan XY
  4470. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  4471. ANG1 = 0. ;
  4472. SINON ;
  4473. ANG1 = -1.* (ATG VX VY) ;
  4474. FINSI ;
  4475. *
  4476. XPTG YPTG = COOR PTG ;
  4477. *
  4478. SI (EGA IPLAN 'PHICONS');
  4479. * ---- Coupe 2D a Phi constant
  4480. XL = ZL ;
  4481. ZL = ZL * 0.;
  4482. * ---- rotation
  4483. XL1 = XL * (COS ANG1) + (YL * (-1.) * (SIN ANG1));
  4484. YL1 = XL * (SIN ANG1) + (YL * (COS ANG1));
  4485. FINSI;
  4486. SI (EGA IPLAN 'THECONS');
  4487. * ---- Coupe 2D a Theta constant
  4488. * ---- rotation
  4489. XL1 = XL * (COS ANG1) + (YL * (-1.) * (SIN ANG1));
  4490. YL1 = XL * (SIN ANG1) + (YL * (COS ANG1));
  4491. FINSI;
  4492. * ---- changement d'origine du repere
  4493. XM = XL1 + XPTG ;
  4494. YM = YL1 + YPTG ;
  4495. ZM = YL1 * 0. ;
  4496. *
  4497. SINON ;
  4498. *
  4499. VEC1 = DIR1 / (NORM DIR1) ;
  4500. DIR2 = CP MOINS PTG ;
  4501. VEC2 = DIR2 / (NORM DIR2) ;
  4502. VEC3 = VEC1 PVEC VEC2 ;
  4503. *
  4504. X0 Y0 Z0 = COOR PTG ;
  4505. A1 B1 C1 = COOR VEC1 ;
  4506. A2 B2 C2 = COOR VEC2 ;
  4507. A3 B3 C3 = COOR VEC3 ;
  4508. *
  4509. XM1 = (A1 * XL) + (A2 * YL) + (A3 * ZL) ;
  4510. YM1 = (B1 * XL) + (B2 * YL) + (B3 * ZL) ;
  4511. ZM1 = (C1 * XL) + (C2 * YL) + (C3 * ZL) ;
  4512. *
  4513. XM = XM1 + X0 ;
  4514. YM = YM1 + Y0 ;
  4515. ZM = ZM1 + Z0 ;
  4516. *
  4517. FINSI ;
  4518. FINPROC XM YM ZM ;
  4519. **** @CRMLC
  4520. DEBPROC @CRMLC XM*CHPOINT YM*CHPOINT ZM*CHPOINT TAB1*TABLE ;
  4521. *
  4522. *******************************************************************
  4523. * Version amelioree de l'ancien @CRMLC rebaptise @ACRML *
  4524. * Procedure de changement de repere. On passe du repere cartesien *
  4525. * du maillage au repere cartesien local de l'objet modelise. Le *
  4526. * point de tangence au plasma est l'origine de ce repere et l'axe *
  4527. * l'axe Y final est dirige vers le centre du plasma. *
  4528. * en 3D l'axe x du repere local est donne par la direction *
  4529. * toroidale *
  4530. * en 2D cas PHICONS l'axe Z initial est l'axe toroidal *
  4531. * en 2D cas THECONS l'axe x initial est l'axe toroidal *
  4532. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  4533. *******************************************************************
  4534. *
  4535. *--------------- VARIABLES D'ENTREE :
  4536. CP = TAB1.CENTRE_PLASMA ;
  4537. PTG = TAB1.PT_TGPLASMA ;
  4538. SI ((VALEUR DIME) EGA 2) ;
  4539. SI (EXISTE TAB1 <PLAN) ;
  4540. IPLAN = TAB1.<PLAN ;
  4541. SINON ;
  4542. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  4543. FINSI ;
  4544. SINON ;
  4545. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  4546. DIR1 = TAB1.<DIR_TOROIDAL ;
  4547. SINON ;
  4548. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  4549. FINSI ;
  4550. FINSI ;
  4551. *------------------------------------
  4552. *
  4553. SI ((VALEUR DIME) EGA 2) ;
  4554. VECT0 = CP MOINS PTG ;
  4555. VX VY = COOR VECT0 ;
  4556. *
  4557. * ---- calcul de l'angle de rotation dans le plan XY
  4558. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  4559. ANG1 = 0. ;
  4560. SINON ;
  4561. ANG1 = -1.* (ATG VX VY) ;
  4562. FINSI ;
  4563. *
  4564. XPTG YPTG = COOR PTG ;
  4565. *
  4566. * ---- changement d'origine du repere
  4567. XM1 = XM - XPTG ;
  4568. YM1 = YM - YPTG ;
  4569. * ---- rotation pour aligner l'axe Y avec VECT0
  4570. SI (EGA IPLAN 'PHICONS');
  4571. * ---- Coupe 2D a Phi constant
  4572. XL = XM1 * (COS ANG1) + (YM1 * (SIN ANG1));
  4573. YL = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1));
  4574. ZL = XM * 0. ;
  4575. *
  4576. ZL = XL ;
  4577. XL = XL * 0.;
  4578. FINSI;
  4579. SI (EGA IPLAN 'THECONS');
  4580. * ---- Coupe 2D a Theta constant
  4581. XL = XM1 * (COS ANG1) + (YM1 * (SIN ANG1));
  4582. YL = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1));
  4583. ZL = XM * 0. ;
  4584. FINSI ;
  4585. *
  4586. SINON ;
  4587. *
  4588. VEC1 = DIR1 / (NORM DIR1) ;
  4589. DIR2 = CP MOINS PTG ;
  4590. VEC2 = DIR2 / (NORM DIR2) ;
  4591. VEC3 = VEC1 PVEC VEC2 ;
  4592. *
  4593. X0 Y0 Z0 = COOR PTG ;
  4594. A1 B1 C1 = COOR VEC1 ;
  4595. A2 B2 C2 = COOR VEC2 ;
  4596. A3 B3 C3 = COOR VEC3 ;
  4597. *
  4598. XM1 = XM - X0 ;
  4599. YM1 = YM - Y0 ;
  4600. ZM1 = ZM - Z0 ;
  4601. *
  4602. XL = (A1 * XM1) + (B1 * YM1) + (C1 * ZM1) ;
  4603. YL = (A2 * XM1) + (B2 * YM1) + (C2 * ZM1) ;
  4604. ZL = (A3 * XM1) + (B3 * YM1) + (C3 * ZM1) ;
  4605. *
  4606. FINSI ;
  4607. FINPROC XL YL ZL ;
  4608.  
  4609.  
  4610. **** @CBTLV
  4611. DEBPROC @CBTLV BRHO*CHPOINT BTHETA*CHPOINT BPHI*CHPOINT THETA*CHPOINT PHI*CHPOINT TAB1*TABLE ;
  4612. *
  4613. *********************************************************************
  4614. * Procedure de changement de base pour un vecteur B de coordonnees *
  4615. * BRHO, BPHI, BTHETA dans une base pseudo-toroidale aux coordonnees *
  4616. * cartesiennes BX, BY, BZ dans la base de l'objet. *
  4617. * Alain MOAL (juin 1995) *
  4618. *********************************************************************
  4619. *
  4620. *--------------- VARIABLES D'ENTREE :
  4621. THETA0 = TAB1.<THETA0 ;
  4622. *------------------------------------
  4623. *
  4624. CT = COS THETA ;
  4625. ST = SIN THETA ;
  4626. CT0 = COS THETA0 ;
  4627. ST0 = SIN THETA0 ;
  4628. MST0 = ST0 * -1. ;
  4629. CPHI = COS PHI ;
  4630. SPHI = SIN PHI ;
  4631. MSPHI= SPHI * -1. ;
  4632. *
  4633. *---- 1) rotation de - Theta autour de "l'axe Phi"
  4634. BRHO1 = (CT * BRHO) - (ST * BTHETA) ;
  4635. BTHETA1 = (ST * BRHO) + (CT * BTHETA) ;
  4636. BPHI1 = BPHI ;
  4637. *
  4638. *---- 2) rotation de - Phi autour de "l'axe Theta"
  4639. BRHO2 = (CPHI * BRHO1) + (MSPHI * BPHI1) ;
  4640. BTHETA2 = BTHETA1 ;
  4641. BPHI2 = (SPHI * BRHO1) + (CPHI * BPHI1) ;
  4642. *
  4643. *---- 3) rotation de Theta0 autour de "l'axe Phi"
  4644. BRHO3 = (BRHO2 * CT0) + (BTHETA2 * ST0) ;
  4645. BTHETA3 = (BRHO2 * MST0) + (BTHETA2 * CT0) ;
  4646. BPHI3 = BPHI2 ;
  4647. *
  4648. *---- 4) composantes dans le repere cartesien
  4649. BX = BPHI3 ;
  4650. BY = BRHO3 * -1. ;
  4651. BZ = BTHETA3 ;
  4652. *
  4653. FINPROC BX BY BZ;
  4654. **** @CBLMV
  4655. DEBPROC @CBLMV VXL*CHPOINT VYL*CHPOINT VZL*CHPOINT TAB1*TABLE ;
  4656. *
  4657. ********************************************************************
  4658. * Version amelioree de l'ancien @CBLMV rebaptise @ACBLM *
  4659. * Procedure de changement de base. On passe de la base cartesienne *
  4660. * locale de l'objet modelise a la base cartesienne du maillage. *
  4661. * l'axe Y est dirige du point de tangence au plasma vers le centre *
  4662. * du plasma. En 3D, L'axe X du repere local est dans la direction *
  4663. * toroidale. *
  4664. * en 2D cas PHICONS l'axe Z du repere local est l'axe toroidal *
  4665. * en 2D cas THECONS l'axe x du repere local est l'axe toroidal *
  4666. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  4667. ********************************************************************
  4668. *
  4669. *--------------- VARIABLES D'ENTREE :
  4670. CP = TAB1.CENTRE_PLASMA ;
  4671. PTG = TAB1.PT_TGPLASMA ;
  4672. SI ((VALEUR DIME) EGA 2) ;
  4673. SI (EXISTE TAB1 <PLAN) ;
  4674. IPLAN = TAB1.<PLAN ;
  4675. SINON ;
  4676. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  4677. FINSI ;
  4678. SINON ;
  4679. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  4680. DIR1 = TAB1.<DIR_TOROIDAL ;
  4681. SINON ;
  4682. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  4683. FINSI ;
  4684. FINSI ;
  4685. *------------------------------------
  4686. *
  4687. SI ((VALEUR DIME) EGA 2) ;
  4688. VECT0 = CP MOINS PTG ;
  4689. VX VY = COOR VECT0 ;
  4690. *
  4691. * ---- calcul de l'angle de rotation dans le plan XY
  4692. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  4693. ANG1 = 0. ;
  4694. SINON ;
  4695. ANG1 = -1.* (ATG VX VY) ;
  4696. FINSI ;
  4697. *
  4698. SI (EGA IPLAN 'PHICONS');
  4699. * ---- Coupe 2D a Phi constant
  4700. VXL1 = VZL ;
  4701. VYL1 = VYL ;
  4702. VZL1 = VXL * (-1.);
  4703. * ---- rotation
  4704. VXM = VXL1 * (COS ANG1) + (VYL1 * (-1.) * (SIN ANG1));
  4705. VYM = VXL1 * (SIN ANG1) + (VYL1 * (COS ANG1)) ;
  4706. VZM = VZL1 ;
  4707. FINSI ;
  4708. SI (EGA IPLAN 'THECONS');
  4709. * ---- Coupe 2D a Theta constant
  4710. * ---- rotation
  4711. VXM = VXL * (COS ANG1) + (VYL * (-1.) * (SIN ANG1)) ;
  4712. VYM = VXL * (SIN ANG1) + (VYL * (COS ANG1)) ;
  4713. VZM = VZL ;
  4714. FINSI;
  4715. *
  4716. SINON ;
  4717. *
  4718. VEC1 = DIR1 / (NORM DIR1) ;
  4719. DIR2 = CP MOINS PTG ;
  4720. VEC2 = DIR2 / (NORM DIR2) ;
  4721. VEC3 = VEC1 PVEC VEC2 ;
  4722. *
  4723. A1 B1 C1 = COOR VEC1 ;
  4724. A2 B2 C2 = COOR VEC2 ;
  4725. A3 B3 C3 = COOR VEC3 ;
  4726. *
  4727. VXM = (A1 * VXL) + (A2 * VYL) + (A3 * VZL) ;
  4728. VYM = (B1 * VXL) + (B2 * VYL) + (B3 * VZL) ;
  4729. VZM = (C1 * VXL) + (C2 * VYL) + (C3 * VZL) ;
  4730. *
  4731. FINSI ;
  4732. FINPROC VXM VYM VZM ;
  4733.  
  4734. **** @CBMLV
  4735. DEBPROC @CBMLV VXM*CHPOINT VYM*CHPOINT VZM*CHPOINT TAB1*TABLE ;
  4736. *
  4737. ********************************************************************
  4738. * Version amelioree de l'ancien @CBMLV rebaptise @ACBML *
  4739. * Procedure de changement de base. On passe de la base cartesienne *
  4740. * du maillage a la base cartesienne locale de l'objet modelise. *
  4741. * l'axe Y final est dirige du point de tangence vers le centre du *
  4742. * plasma. En 3D l'axe x du repere local est donne par la direction *
  4743. * toroidale *
  4744. * en 2D cas PHICONS l'axe Z initial est l'axe toroidal *
  4745. * en 2D cas THECONS l'axe x initial est l'axe toroidal *
  4746. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  4747. ********************************************************************
  4748. *
  4749. *--------------- VARIABLES D'ENTREE :
  4750. CP = TAB1.CENTRE_PLASMA ;
  4751. PTG = TAB1.PT_TGPLASMA ;
  4752. SI ((VALEUR DIME) EGA 2) ;
  4753. SI (EXISTE TAB1 <PLAN) ;
  4754. IPLAN = TAB1.<PLAN ;
  4755. SINON ;
  4756. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  4757. FINSI ;
  4758. SINON ;
  4759. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  4760. DIR1 = TAB1.<DIR_TOROIDAL ;
  4761. SINON ;
  4762. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  4763. FINSI ;
  4764. FINSI ;
  4765. *------------------------------------
  4766. *
  4767. SI ((VALEUR DIME) EGA 2) ;
  4768. VECT0 = CP MOINS PTG ;
  4769. VX VY = COOR VECT0 ;
  4770. *
  4771. * ---- calcul de l'angle de rotation dans le plan XY
  4772. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  4773. ANG1 = 0. ;
  4774. SINON ;
  4775. ANG1 = -1.* (ATG VX VY) ;
  4776. FINSI ;
  4777. *
  4778. * ---- rotation pour aligner l'axe Y avec VECT0
  4779. SI (EGA IPLAN 'PHICONS');
  4780. * ---- Coupe 2D a Phi constant
  4781. VXL1 = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  4782. VYL1 = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  4783. VZL1 = VZM ;
  4784. * ---- Coupe 2D a Phi constant
  4785. VXL = VZL1 ;
  4786. VYL = VYL1 ;
  4787. VZL = VXL1 * (-1.);
  4788. FINSI ;
  4789. SI (EGA IPLAN 'THECONS');
  4790. * ---- Coupe 2D a Theta constant
  4791. * ---- rotation
  4792. VXL = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  4793. VYL = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  4794. VZL = VZM ;
  4795. FINSI ;
  4796. *
  4797. SINON ;
  4798. *
  4799. VEC1 = DIR1 / (NORM DIR1) ;
  4800. DIR2 = CP MOINS PTG ;
  4801. VEC2 = DIR2 / (NORM DIR2) ;
  4802. VEC3 = VEC1 PVEC VEC2 ;
  4803. *
  4804. A1 B1 C1 = COOR VEC1 ;
  4805. A2 B2 C2 = COOR VEC2 ;
  4806. A3 B3 C3 = COOR VEC3 ;
  4807. *
  4808. VXL = (A1 * VXM) + (B1 * VYM) + (C1 * VZM) ;
  4809. VYL = (A2 * VXM) + (B2 * VYM) + (C2 * VZM) ;
  4810. VZL = (A3 * VXM) + (B3 * VYM) + (C3 * VZM) ;
  4811. *
  4812. FINSI ;
  4813. FINPROC VXL VYL VZL ;
  4814. **** @CHAQT
  4815. 'DEBPROC' @CHAQT MOD_1*MMODEL MCH_1/MCHAML CHP_1/CHPOINT MM_1/MOT ;
  4816. * modification raph MITTEAU le 22 fevrier 1994 pour
  4817. * que CHAQT ne fasse rien en 3D
  4818.  
  4819. MAI_1 = EXTR MOD_1 'MAIL' ;
  4820. SI (EGA (VALE DIME) 2) ;
  4821. SI ( existe MM_1 ) ;
  4822. MM_11 = MM_1 ;
  4823. SINON ;
  4824. MM_11 = 'MECANIQUE ELASTIQUE ' ;
  4825. FINSI ;
  4826. SI ( existe MCH_1 ) ;
  4827. * M_21 = chan 'NOEUD' MOD_1 ( REDU MCH_1 MAI_1) ;
  4828. M_21 = chan 'NOEUD' MOD_1 ( REDU MCH_1 MOD_1) ;
  4829. CHP_21 = chan 'CHPO' MOD_1 M_21 ;
  4830. FINSI ;
  4831. SI ( existe CHP_1 ) ;
  4832. CHP_21 = (REDU CHP_1 MAI_1) ;
  4833. M_21 = chan CHAM CHP_21 MOD_1 'NOEUD' ;
  4834. FINSI ;
  4835. SI ((NON ( existe CHP_1 )) ET (NON ( existe MCH_1))) ;
  4836. ERRE 'IL FAUT DONNER UN CHPOINT OU UN MCHAML' ;
  4837. FINSI ;
  4838. * MAI_2 = chan tri6 MAI_1 ;
  4839. n_t6 = MAXI (nbel MAI_1 ( MOTS TRI6)) ;
  4840. n_q8 = MAXI (nbel MAI_1 ( MOTS QUA8));
  4841. * MESS 'nbre de Q8:' n_q8 'nbre de TRI6:' n_t6 ;
  4842. SI ( n_q8 > 0 ) ;
  4843. MAI_Q8 = MAI_1 ELEM QUA8 ;
  4844. SI ( n_t6 > 0 ) ;
  4845. MAI_T6 = MAI_1 ELEM TRI6 ;
  4846. MAI_2 = (chan tri6 MAI_Q8) ET MAI_T6 ;
  4847. SINON ;
  4848. MAI_2 = chan tri6 MAI_Q8 ;
  4849. FINSI ;
  4850. * MOD_2 = MODE MAI_2 mecanique elastique ;
  4851. TT_1 = TEXTE MM_11 ;
  4852. MOD_2 = MODE MAI_2 TT_1 ;
  4853. * il faut utiliser diff pour ne faire le proi que sur les noeuds nouveaux
  4854. POI_NEW = DIFF ( CHAN POI1 MAI_1 ) ( CHAN POI1 MAI_2 );
  4855. CHP_22 = @ET CHP_21 ( proi POI_NEW M_21 ) ;
  4856. SINON ;
  4857. MAI_2 = MAI_1 ;
  4858. CHP_22 = CHP_21 ;
  4859. MOD_2 = MOD_1 ;
  4860. FINSI ;
  4861. m_22 = chan cham CHP_22 MOD_2 ;
  4862. SINON;
  4863. m_22 = REDU MCH_1 MOD_1 ;
  4864. MOD_2 = MOD_1;
  4865. MAI_2 = MAI_1 ;
  4866. FINSI ;
  4867.  
  4868. 'FINPROC' m_22 MOD_2 MAI_2 ;
  4869.  
  4870.  
  4871. *----------------------------------------------------------------------*
  4872. * *
  4873. * C H A Q T *
  4874. * --------- *
  4875. * DATE 93/05/07
  4876. * procedure CHAQT (DRFC - J. Schlosser)
  4877. * ------------------------------------------
  4878. *
  4879. * MCHPO2 MAIL2 = CHAQT3D MOD1 OBJET1 MAIL1
  4880. *
  4881. *
  4882. *
  4883. * Objet :
  4884. * _________
  4885. *
  4886. * Etant donne un objet de type MCHAML ou CHPOINT , OBJET1,
  4887. * defini sur un MMODEL massif,MOD1,compose de QUA8 et TRI6 (ou
  4888. * en 3D de CU20 PR15) et un sous ensemble MAIL1 du maillage MAITOT1
  4889. * correspondant a MOD1 ( en 3D par exemple
  4890. * l enveloppe) compose de QUA8 et TRI6. La procedure cree
  4891. * un CHPOINT defini sur un nouveau maillage compose exclusivement
  4892. * de TRI6 afin de pouvoir effectue un trace d isovaleur plus correct
  4893. * ( le QUA8 initial se trouve ainsi transforme en QUA9 avec un point
  4894. * milieu ce qui permet un decoupage en 8 triangles lineaires. Cela
  4895. * revient a approximer la variation quadratique dans l element par
  4896. * une variation bilineaire)
  4897. *
  4898. * *
  4899. * Commentaire
  4900. * _____________
  4901. *
  4902. *
  4903. * MOD1 : objet de type MODE (elements massifs)
  4904. *
  4905. * OBJET1 : objet de type MCHAML ou CHPOINT
  4906. *
  4907. * MAIL1 : objet de type MAILLAGE compose de TRI6 et de QUA8
  4908. *
  4909. * MCHPO2 : objet de type CHPOINT
  4910. *
  4911. * MAIL2 : objet de type MAILLAGE compose de TRI6
  4912. *
  4913. *
  4914. *
  4915. * *
  4916. * Remarque
  4917. * _____________
  4918. *
  4919. *
  4920. * la procedure utilise grosso modo
  4921. * MAIL2 = chan tri6 MAIL1 ;
  4922. * MCHPO2 =proi MAIL2 MCHPO1 ;
  4923. * ce shema brut est optimisee et la procedure ne
  4924. * fait la projection que sur les points nouveaux milieux des QUA8
  4925. * ( malheureusement PROI ne calcule pas dans ce cas les bonnnes valeurs)
  4926. *
  4927. * Attention on voit que l on passe par l intermediaire d un CHPOINT
  4928. * les valeurs vont se trouver moyennees aux interfaces des materiaux
  4929. * si vous le souhaitez, procedez materiau par materiau !
  4930. * l' OBJET1 est REDUIT a MOD_1 a l entree de la procedure
  4931. *----------------------------------------------------------------------*
  4932. *123456789012345678901234567890123456789012345678901234567890123456789012
  4933. * 1 2 3 4 5 6 7
  4934. 'DEBPROC' CHAQT3D MOD_1*MMODEL MCH_1/MCHAML CHP_1/CHPOINT MAI_1*MAILLAGE ;
  4935. MAITOT1 = EXTR MOD_1 'MAIL' ;
  4936. SI ( existe MCH_1 ) ;
  4937. M_21 = REDU MCH_1 MOD_1 ;
  4938. M_21 = chan 'NOEUD' MOD_1 M_21 ;
  4939. CHP_21 = chan 'CHPO' MOD_1 M_21 ;
  4940. CHP_20 = REDU CHP_21 MAI_1 ;
  4941. FINSI ;
  4942. SI ( existe CHP_1 ) ;
  4943. CHP_20 = REDU CHP_1 MAI_1 ;
  4944. CHP_21 = REDU CHP_1 MAITOT1 ;
  4945. M_21 = chan CHAM CHP_21 MOD_1 'NOEUD' ;
  4946. * M_21 = chan CHAM CHP_21 MOD_1 'STRESSES' ;
  4947. FINSI ;
  4948. SI ((NON ( existe CHP_1 )) ET (NON ( existe MCH_1))) ;
  4949. ERRE 'IL FAUT DONNER UN CHPOINT OU UN MCHAML' ;
  4950. FINSI ;
  4951. *
  4952. n_t6 = MAXI (nbel MAI_1 ( MOTS TRI6)) ;
  4953. n_q8 = MAXI (nbel MAI_1 ( MOTS QUA8));
  4954. MESS 'nbre de Q8:' n_q8 'nbre de TRI6:' n_t6 ;
  4955. SI ( n_q8 > 0 ) ;
  4956. MAI_Q8 = MAI_1 ELEM QUA8 ;
  4957. SI ( n_t6 > 0 ) ;
  4958. MAI_T6 = MAI_1 ELEM TRI6 ;
  4959. MAI_2 = (chan tri6 MAI_Q8) ET MAI_T6 ;
  4960. SINON ;
  4961. MAI_2 = chan tri6 MAI_Q8 ;
  4962. FINSI ;
  4963.  
  4964. * il faut utiliser diff pour ne faire le proi que sur les noeuds nouveaux
  4965. POI_NEW = DIFF ( CHAN POI1 MAI_1 ) ( CHAN POI1 MAI_2 );
  4966. * trac ( 1.e5 5.e4 -1.e5 ) CHP_20 MAI_1 ;
  4967. * trac ( 1.e5 5.e4 -1.e5 ) M_21 MOD_1 MAI_1 ;
  4968. * trac ( 1.e5 5.e4 -1.e5 ) ( MAI_1 et POI_NEW );
  4969. * trac face ( 1.e5 5.e4 -1.e5 ) MAI_2 ;
  4970. CHP_22 = CHP_20 ET ( proi POI_NEW M_21 ) ;
  4971. * trac ( 1.e5 5.e4 -1.e5 ) CHP_22 MAI_2 ;
  4972.  
  4973. SINON ;
  4974. MAI_2 = MAI_1 ;
  4975. CHP_22 = CHP_21 ;
  4976. FINSI ;
  4977. 'FINPROC' CHP_22 MAI_2 ;
  4978.  
  4979. ******************************************
  4980. * *
  4981. * procedure CHREP : changement de repere *
  4982. * *
  4983. ******************************************
  4984. DEBPROC CHREP CHOIX*MOT CH_2/CHPOINT CH_M/MCHAML CH_PP2/CHPOINT CH_MP/MCHAML ;
  4985. MESS '----------------------> entree dans CHREP ';
  4986. SI ( EXISTE CH_2);
  4987. CH_1 = CH_2 ;
  4988. CH_PP = CH_PP2 ;
  4989. SINON ;
  4990. CH_1 = CH_M ;
  4991. CH_PP = CH_MP;
  4992. FINSI;
  4993.  
  4994. V1 = VALEUR DIME ;
  4995. MESS'DIMENSION';
  4996. V2 = VALEUR MODE ;
  4997. P = TABLE ;
  4998. P.1 = TABLE ;
  4999. P.2 = TABLE ;
  5000. P.3 = TABLE ;
  5001. S = TABLE ;
  5002. S.1 = TABLE ;
  5003. S.2 = TABLE ;
  5004. S.3 = TABLE ;
  5005. SP = TABLE ;
  5006. SP.1 = TABLE ;
  5007. SP.2 = TABLE ;
  5008. SP.3 = TABLE ;
  5009.  
  5010. LISTCOM1 = EXTR CH_1 'COMP';
  5011. LISTCOM2 = EXTR CH_PP 'COMP';
  5012.  
  5013. MR2D_1 = CHAINE 'TX ' 'TY ' 'NX ' 'NY ' ;
  5014. MR2D_2 = CHAINE 'P11 ' 'P12 ' 'P21 ' 'P22 ' ;
  5015. MR3D_1 = CHAINE 'TX ' 'TY ' 'TZ ' 'NX ' 'NY ' 'NZ ' 'BX ' 'BY ' 'BZ ';
  5016. MR3D_2 = CHAINE 'P11 ' 'P12 ' 'P13 ' 'P21 ' 'P22 ' 'P23 ' 'P31 ' 'P32 ' 'P33 ' ;
  5017. SI ( EGA CHOIX 'CONTRAINTES' ) ;
  5018. MC2D_1 = CHAINE 'SMXX' 'SMYY' 'SMZZ' 'SMXY' ;
  5019. MC2D_2 = CHAINE 'SMRR' 'SMZZ' 'SMTT' 'SMRZ' ;
  5020. MC3D_1 = CHAINE 'SMXX' 'SMYY' 'SMZZ' 'SMXY' 'SMXZ' 'SMYZ' ;
  5021. FINSI ;
  5022. SI ( EGA CHOIX 'DEFORMATIONS' ) ;
  5023. MC2D_1 = CHAINE 'EPXX' 'EPYY' 'EPZZ' 'EPXY' ;
  5024. MC2D_2 = CHAINE 'EPRR' 'EPZZ' 'EPTT' 'EPRZ' ;
  5025. MC3D_1 = CHAINE 'EPXX' 'EPYY' 'EPZZ' 'EPXY' 'EPXZ' 'EPYZ' ;
  5026. FINSI ;
  5027. SI (V1 EGA 2) ;
  5028. MCR1 = CHAINE (EXTR LISTCOM2 1) (EXTR LISTCOM2 2) (EXTR LISTCOM2 3) (EXTR LISTCOM2 4) ;
  5029. MCC1 = CHAINE (EXTR LISTCOM1 1) (EXTR LISTCOM1 2) (EXTR LISTCOM1 3) (EXTR LISTCOM1 4) ;
  5030. MESS '>>>CHREP>>>' MCR1 ;
  5031. MESS '>>>CHREP>>>' MR2D_1 ;
  5032. SI ( NON (( EGA MCR1 MR2D_1) OU ( EGA MCR1 MR2D_2)) ) ;
  5033. MESS '>>>CHREP>>> COMPOSANTES REPERE TROUVEES :' MCR1 ;
  5034. MESS '>>>CHREP>>> AU LIEU DE :' MR2D_1 ;
  5035. MESS '>>>CHREP>>> OU BIEN :' MR2D_2 ;
  5036. ERREUR 'COMP_REP_NON_ADMISES' ;
  5037. FINSI;
  5038. SI ( NON (( EGA MCC1 MC2D_1) OU ( EGA MCC1 MC2D_2)) ) ;
  5039. MESS '>>>CHREP>>> COMPOSANTES REPERE TROUVEES :' MCC1 ;
  5040. MESS '>>>CHREP>>> AU LIEU DE :' MC2D_1 ;
  5041. MESS '>>>CHREP>>> OU BIEN :' MC2D_2 ;
  5042. ERREUR 'COMP_CHAMP_NON_ADMISES' ;
  5043. FINSI;
  5044. FINSI;
  5045. SI (V1 EGA 3) ;
  5046. MCR1 = CHAINE (EXTR LISTCOM2 1) (EXTR LISTCOM2 2) (EXTR LISTCOM2 3) (EXTR LISTCOM2 4) (EXTR LISTCOM2 5) (EXTR LISTCOM2 6) (EXTR LISTCOM2 7) (EXTR LISTCOM2 8) (EXTR LISTCOM2 9) ;
  5047. MCC1 = CHAINE (EXTR LISTCOM1 1) (EXTR LISTCOM1 2) (EXTR LISTCOM1 3) (EXTR LISTCOM1 4) (EXTR LISTCOM1 5) (EXTR LISTCOM1 6) ;
  5048. SI ( NON ( EGA MCR1 MR3D_1) ) ;
  5049. MESS '>>>CHREP>>> COMPOSANTES REPERE TROUVEES :' MCR1 ;
  5050. MESS '>>>CHREP>>> AU LIEU DE :' MR3D_1 ;
  5051. ERREUR 'COMP_REP_NON_ADMISES' ;
  5052. FINSI;
  5053. SI ( NON ( EGA MCC1 MC3D_1) ) ;
  5054. MESS '>>>CHREP>>> COMPOSANTES REPERE TROUVEES :' MCC1 ;
  5055. MESS '>>>CHREP>>> AU LIEU DE :' MC3D_1 ;
  5056. ERREUR 'COMP_CHAMP_NON_ADMISES' ;
  5057. FINSI;
  5058. FINSI;
  5059.  
  5060. SI (V1 EGA 2);
  5061. P.1 . 1 = EXCO (EXTR LISTCOM2 1) CH_PP SCAL ;
  5062. P.1 . 2 = EXCO (EXTR LISTCOM2 2) CH_PP SCAL ;
  5063. P.2 . 1 = EXCO (EXTR LISTCOM2 3) CH_PP SCAL ;
  5064. P.2 . 2 = EXCO (EXTR LISTCOM2 4) CH_PP SCAL ;
  5065. S.1 . 1 = EXCO (EXTR LISTCOM1 1) CH_1 SCAL ;
  5066. S.1 . 2 = EXCO (EXTR LISTCOM1 4) CH_1 SCAL ;
  5067. S.2 . 1 = S.1 . 2 ;
  5068. S.2 . 2 = EXCO (EXTR LISTCOM1 2) CH_1 SCAL ;
  5069. S.3 . 3 = EXCO (EXTR LISTCOM1 3) CH_1 SCAL ;
  5070. FINSI;
  5071. SI (V1 > 2) ;
  5072. P.1 . 1 = EXCO (EXTR LISTCOM2 1) CH_PP SCAL ;
  5073. P.1 . 2 = EXCO (EXTR LISTCOM2 2) CH_PP SCAL ;
  5074. P.1 . 3 = EXCO (EXTR LISTCOM2 3) CH_PP SCAL ;
  5075. P.2 . 1 = EXCO (EXTR LISTCOM2 4) CH_PP SCAL ;
  5076. P.2 . 2 = EXCO (EXTR LISTCOM2 5) CH_PP SCAL ;
  5077. P.2 . 3 = EXCO (EXTR LISTCOM2 6) CH_PP SCAL ;
  5078. P.3 . 1 = EXCO (EXTR LISTCOM2 7) CH_PP SCAL ;
  5079. P.3 . 2 = EXCO (EXTR LISTCOM2 8) CH_PP SCAL ;
  5080. P.3 . 3 = EXCO (EXTR LISTCOM2 9) CH_PP SCAL ;
  5081. *
  5082. S.1 . 1 = EXCO (EXTR LISTCOM1 1) CH_1 SCAL ;
  5083. S.1 . 2 = EXCO (EXTR LISTCOM1 4) CH_1 SCAL ;
  5084. S.2 . 1 = S.1 . 2 ;
  5085. S.2 . 2 = EXCO (EXTR LISTCOM1 2) CH_1 SCAL ;
  5086. S.3 . 3 = EXCO (EXTR LISTCOM1 3) CH_1 SCAL ;
  5087. S.1 . 3 = EXCO (EXTR LISTCOM1 5) CH_1 SCAL ;
  5088. S.2 . 3 = EXCO (EXTR LISTCOM1 6) CH_1 SCAL ;
  5089. S.3 . 1 = S.1 . 3 ;
  5090. S.3 . 2 = S.2 . 3 ;
  5091.  
  5092. I = 0;
  5093. REPETER BOUCS1 3;
  5094. I = I + 1;
  5095. J = I - 1;
  5096. REPETER BOUCS2 ( 3 + 1 - I );
  5097. J = J + 1;
  5098. SP.I.J = 0.;
  5099. L = 0;
  5100. REPETER BOUCS3 3;
  5101. L = L + 1;
  5102. Q = 0;
  5103. REPETER BOUCS4 3;
  5104. Q = Q + 1;
  5105. SP.I.J = (SP.I.J) + ( (P.I.L) * ( P.J.Q) * (S.L.Q )) ;
  5106. FIN BOUCS4;
  5107. FIN BOUCS3;
  5108. FIN BOUCS2;
  5109. FIN BOUCS1;
  5110. SI ( EGA CHOIX CONTRAINTES);
  5111. CH_2 = ( NOMC 'SMTT' SP.1 . 1 ) @ET ( NOMC 'SMNN' SP.2 . 2 ) @ET ( NOMC 'SMBB' SP.3 . 3 ) @ET ( NOMC 'SMTN' SP.1 . 2 ) @ET ( NOMC 'SMTB' SP.1 . 3 ) @ET ( NOMC 'SMNB' SP.2 . 3 );
  5112. SINON;
  5113. CH_2 = ( NOMC 'EPTT' SP.1 . 1 ) @ET ( NOMC 'EPNN' SP.2 . 2 ) @ET ( NOMC 'EPBB' SP.3 . 3 ) @ET ( NOMC 'EPTN' SP.1 . 2 ) @ET ( NOMC 'EPTB' SP.1 . 3 ) @ET ( NOMC 'EPNB' SP.2 . 3 );
  5114. FINSI;
  5115.  
  5116. SINON;
  5117. I = 0;
  5118. REPETER BOUCS11 2;
  5119. I = I + 1;
  5120. J = I-1;
  5121. REPETER BOUCS21 (2+1-I);
  5122. J = J + 1;
  5123. SP.I.J = 0. ;
  5124. L = 0;
  5125. REPETER BOUCS31 2;
  5126. L = L + 1;
  5127. Q = 0 ;
  5128. REPETER BOUCS41 2;
  5129. Q = Q + 1;
  5130. SP.I.J = (SP.I.J) + ( (P.I.L) * ( P.J.Q) * (S.L.Q )) ;
  5131. FIN BOUCS41;
  5132. FIN BOUCS31;
  5133. FIN BOUCS21;
  5134. FIN BOUCS11;
  5135. SP.3 . 3 = S.3 . 3;
  5136. SI ( EGA CHOIX CONTRAINTES);
  5137. CH_2 = ( NOMC 'SMTT' SP.1 . 1 ) @ET ( NOMC 'SMNN' SP.2 . 2 ) @ET ( NOMC 'SMBB' SP.3 . 3 ) @ET ( NOMC 'SMTN' SP.1 . 2 );
  5138. SINON;
  5139. CH_2 = ( NOMC 'EPTT' SP.1 . 1 ) @ET ( NOMC 'EPNN' SP.2 . 2 ) @ET ( NOMC 'EPBB' SP.3 . 3 ) @ET ( NOMC 'EPTN' SP.1 . 2 );
  5140. FINSI;
  5141.  
  5142. FINSI;
  5143. MESS '----------------------> sortie de CHREP ';
  5144. FINPROC CH_2;
  5145. **** @CLAMQ
  5146. DEBPROC @CLAMQ TAB1*TABLE XM*CHPOINT YM*CHPOINT ZM*CHPOINT ISHIFT*LOGIQUE IRIPPLE*LOGIQUE ;
  5147. *
  5148. ***********************************************************
  5149. * Procedure de calcul du parametre Lambdaq necessaire au *
  5150. * calcul du profil du depot de puissance en chaque point *
  5151. * de la surface de la structure modelisee. *
  5152. * Alain MOAL (juin 1995) *
  5153. ***********************************************************
  5154. *
  5155. MESS '---------------------------------> calling @CLAMQ';
  5156. *
  5157. *--------------- VARIABLES D'ENTREE :
  5158. RP = TAB1.<RP ;
  5159. HP = TAB1.<HP ;
  5160. RHO0 = TAB1.<RHO0 ;
  5161. THETA0 = TAB1.<THETA0 ;
  5162. ANGPHI0 = TAB1.<ANGPHI0 ;
  5163. RR = TAB1.<RR ;
  5164. LAMB = TAB1.<LAMB ;
  5165. LAMBQREF = TAB1.<LAMBQREF ;
  5166. THETAREF = TAB1.<THETAREF ;
  5167. IPLASMA = TAB1.<IPLASMA ;
  5168. COEFA = TAB1.<COEFA ;
  5169. COEFB = TAB1.<COEFB ;
  5170. COEFC = TAB1.<COEFC ;
  5171. RHOMER = TAB1.<RHOMER ;
  5172. NBOB = TAB1.<NBOB ;
  5173. IMESS = TAB1.<IMESS ;
  5174. *------------------------------------
  5175. *
  5176. PI = 3.141592 ;
  5177. MU0 = 4.E-7 * PI ;
  5178. *
  5179. *---- Coordonnees de chaque point dans le repere du plasma
  5180. RHOP THETAP PHIP = @CRGTC XM YM ZM RP HP ;
  5181. *
  5182. *---- Masque delimitant le domaine de validite du modele de ripple
  5183. *attention domaine de validite etendu a 180 par E.COSTA et
  5184. *E.TSITRONE le 02/06/97
  5185. *MASK0 = (ABS THETAP) MASQUE INFERIEUR 110. ;
  5186. MASK0 = (ABS THETAP) MASQUE INFERIEUR 180. ;
  5187. *
  5188. SI ISHIFT ;
  5189. AUX0 = -1. * MU0 * IPLASMA / (2. * PI) ;
  5190. *
  5191. BPTHEREF = (((RHOP/RP) * (COS THETAREF) * LAMB) + 1.) * AUX0 ;
  5192. BPTHE = (((COS THETAP) * (RHOP/RP) * LAMB) + 1.) * AUX0 ;
  5193. *
  5194. * ---- facteur de compression des lignes de champ due au shift
  5195. H1 = (RHOP * (COS THETAREF) + RP) * BPTHEREF ;
  5196. H2 = ((COS THETAP) * RHOP + RP) * BPTHE ;
  5197. HS = H2 ** -1 * H1 ;
  5198. SINON ;
  5199. HS = RHOP * 0. + 1. ;
  5200. FINSI ;
  5201. *
  5202. SI IRIPPLE ;
  5203. * ---- enveloppe de la DSMF dans le repere adapte au calcul du ripple
  5204. * ---- Rho0 dans le "repere du ripple"
  5205. RHOR THETAR PHIR = @CRGTC XM YM ZM RR 0. ;
  5206. *
  5207. RHO0R = ((RHO0**2) + ((RP - RR)**2) + (2. * RHO0 * (RP - RR) * (COS THETAP)))**0.5 ;
  5208. RHODSMFR = (EXP((THETAR**2) * -1. * COEFC)) * (EXP(COEFB * RHO0R)) * ((COS((PHIR + ANGPHI0) * NBOB)) - 1.) * COEFA + RHO0R;
  5209. * ---- dans le repere du plasma
  5210. RHODSMFP = RHODSMFR * 2. * (RR - RP) * (COS THETAR) ;
  5211. RHODSMFP = RHODSMFP + ((RR - RP)**2) + (RHODSMFR**2) ;
  5212. RHODSMFP = RHODSMFP**0.5 ;
  5213. RHOMERP = RHOMER * 2. * (RR - RP) * (COS THETAR) ;
  5214. RHOMERP = RHOMERP + ((RR - RP)**2) + (RHOMER**2) ;
  5215. RHOMERP = RHOMERP**0.5 ;
  5216. *
  5217. * ---- facteur de compression des lignes de champ due au ripple
  5218. * ---- Rem : le masque sert a traiter le cas Rhomer = Rho0r
  5219. * ---- dans le repere du ripple
  5220. *AM1** MASQ1 = ((ABS(RHOR - RHODSMFR)) MASQUE INFERIEUR 1.E-6)*1.E-6;
  5221. *AM1** MASQ2 = ((ABS(RHOMER - RHO0R)) MASQUE INFERIEUR 1.E-6)*1.E-6 ;
  5222. *AM1** HR = ((RHOR - RHODSMFR) + MASQ1) / ((RHOMER - RHO0R) + MASQ2) ;
  5223. * ---- dans le repere du plasma
  5224. *AM2** MASQ1 = ((ABS(RHOP - RHODSMFP)) MASQUE INFERIEUR 1.E-6)*1.E-6;
  5225. *AM2** MASQ2 = ((ABS(RHOMERP - RHO0)) MASQUE INFERIEUR 1.E-6)*1.E-6 ;
  5226. *AM2** HR = ((RHOP - RHODSMFP) + MASQ1) / ((RHOMERP - RHO0) + MASQ2);
  5227. *AM*** HR = MASK0 * HR + ((1.-MASK0) * 1.) ;
  5228. * ---- Pas de compression des lignes de champ due au ripple
  5229. HR = RHOP * 0. + 1. ;
  5230. SINON ;
  5231. HR = RHOP * 0. + 1. ;
  5232. FINSI ;
  5233. *
  5234. LAMBQ = HR * HS * LAMBQREF ;
  5235. *
  5236. *---- distance a la derniere surface magnetique avec ripple
  5237. SI IRIPPLE ;
  5238. * ---- dans le repere du plasma
  5239. DELTA = MASK0 * (RHOP - RHODSMFP) + ((1.-MASK0) * (RHOP - RHO0));
  5240. * ---- dans le repere du ripple
  5241. *AM1** DELTA = MASK0 * (RHOR - RHODSMFR) + ((1.-MASK0) * (RHOR - RHO0R));
  5242. SINON ;
  5243. DELTA = RHOP - RHO0 ;
  5244. FINSI ;
  5245. *
  5246. *---- messages de verification
  5247. SI (IMESS >EG 3) ;
  5248. MESS '>>>> in @CLAMQ : RHO0R '; LIST RHO0R ;
  5249. MESS '>>>> in @CLAMQ : RHODSMFR '; LIST RHODSMFR ;
  5250. MESS '>>>> in @CLAMQ : RHO0R '; LIST RHO0R ;
  5251. MESS '>>>> in @CLAMQ : HR '; LIST HR ;
  5252. MESS '>>>> in @CLAMQ : HS '; LIST HS ;
  5253. MESS '>>>> in @CLAMQ : LAMBQ '; LIST LAMBQ ;
  5254. MESS '>>>> in @CLAMQ : DELTA '; LIST DELTA ;
  5255. FINSI ;
  5256. *
  5257. SI (IMESS >EG 2) ;
  5258. MESS '>>>> in @CLAMQ : max and min values of HR ';
  5259. MESS (MAXI HR) (MINI HR) ;
  5260. MESS '>>>> in @CLAMQ : max and min values of HS ';
  5261. MESS (MAXI HS) (MINI HS) ;
  5262. MESS '>>>> in @CLAMQ : max and min values of LAMBQ ';
  5263. MESS (MAXI LAMBQ) (MINI LAMBQ) ;
  5264. MESS '>>>> in @CLAMQ : max and min values of DELTA ';
  5265. MESS (MAXI DELTA) (MINI DELTA) ;
  5266. FINSI ;
  5267. *
  5268. MESS '---------------------------------> exiting @CLAMQ';
  5269. FINPROC LAMBQ HS HR DELTA ;
  5270.  
  5271.  
  5272.  
  5273.  
  5274. **** @CLIGB
  5275. DEBPROC @CLIGB NBPAS0*ENTIER PASB0*FLOTTANT TAB1*TABLE TABLIG1*TABLE IMETHOD*ENTIER;
  5276. *
  5277. *****************************************************************
  5278. * Procedure de calcul des lignes de champ magnetique partant de *
  5279. * chaque point d'une geometrie donnee. *
  5280. * methode 1 : methode explicite (tangentes) *
  5281. * methode 2 : Methode iterative avec convergence sur un critere *
  5282. * d'appartenance a la surface magnetique *
  5283. * Alain MOAL (mars 1996) *
  5284. *****************************************************************
  5285. *
  5286. MESS '---------------------------------> calling @CLIGB';
  5287. *
  5288. * ---- Valeurs par defaut
  5289. @VDEFAUT TAB1 ;
  5290. *
  5291. *--------------- VARIABLES D'ENTREE :
  5292. LISTE0 = TAB1.<LI_LIGNE_B ;
  5293. TYPCAL = TAB1.<TYPE_CALCUL ;
  5294. RP = TAB1.<RP ;
  5295. RR = TAB1.<RR ;
  5296. HP = TAB1.<HP ;
  5297. EPS0 = TAB1.<EPS ;
  5298. COEFA = TAB1.<COEFA ;
  5299. COEFB = TAB1.<COEFB ;
  5300. COEFC = TAB1.<COEFC ;
  5301. NBOB = TAB1.<NBOB ;
  5302. SI (EXISTE TAB1 <LPT) ;
  5303. RHO0 = TAB1.<RHO0 ;
  5304. FINSI ;
  5305. *------------------------------------
  5306. *
  5307. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  5308. ISHIFT = VRAI ;
  5309. IRIPPLE = VRAI ;
  5310. FINSI ;
  5311. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  5312. ISHIFT = VRAI ;
  5313. IRIPPLE = FAUX ;
  5314. FINSI ;
  5315. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  5316. ISHIFT = FAUX ;
  5317. IRIPPLE = VRAI ;
  5318. FINSI ;
  5319. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  5320. ISHIFT = FAUX ;
  5321. IRIPPLE = FAUX ;
  5322. FINSI ;
  5323. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  5324. ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
  5325. FINSI ;
  5326.  
  5327. SI (IMETHOD EGA 1) ;
  5328. * ---- Methode explicite simple (tangentes)
  5329. I0 = 0 ;
  5330.  
  5331. REPETER BOUCLE0 (DIME LISTE0);
  5332.  
  5333. I0 = I0 + 1 ; list I0 ;
  5334. P0 = TEXT (EXTR I0 LISTE0) ;
  5335. XM YM ZM = COOR P0 ;
  5336. TABLIG1.I0 = ((XM+1.E-6) YM ZM) D 1 P0 ;
  5337.  
  5338. * ---- Transformation en champ par point
  5339. XM0 = MANU CHPO P0 1 SCAL XM ;
  5340. YM0 = MANU CHPO P0 1 SCAL YM ;
  5341. ZM0 = MANU CHPO P0 1 SCAL ZM ;
  5342.  
  5343. * ---- Coordonnees dans le repere global du tore
  5344. XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
  5345. *
  5346. I1 = 0 ;
  5347. REPETER BOUCLE1 NBPAS0 ;
  5348. * I1 = I1 + 1 ; MESS 'I1 = ' I1;
  5349. * ---- Calcul du champ dans le repere global
  5350. BXG BYG BZG FSECU = @CHAMB TAB1 XG_OLD YG_OLD ZG_OLD ISHIFT IRIPPLE ;
  5351.  
  5352. NORM_B = ((BXG*BXG) + (BYG*BYG) + (BZG*BZG))**0.5 ;
  5353.  
  5354. XG_NEW = XG_OLD - (BXG * PASB0 / NORM_B) ;
  5355. YG_NEW = YG_OLD - (BYG * PASB0 / NORM_B) ;
  5356. ZG_NEW = ZG_OLD - (BZG * PASB0 / NORM_B) ;
  5357.  
  5358. * ---- Coordonnees dans le repere du maillage
  5359. XM_NEW YM_NEW ZM_NEW = @CRGMC XG_NEW YG_NEW ZG_NEW TAB1 ;
  5360.  
  5361. XM1 = EXTR XM_NEW SCAL P0 ;
  5362. YM1 = EXTR YM_NEW SCAL P0 ;
  5363. ZM1 = EXTR ZM_NEW SCAL P0;
  5364.  
  5365. SI (EXISTE TAB1 <LPT) ;
  5366. * ---- traitement particulier pour le LPT
  5367. * ---- on change la couleur de la ligne qui
  5368. * ---- passe au dessous
  5369. XM2 YM2 ZM2 = @CRGMC XG_OLD YG_OLD ZG_OLD TAB1;
  5370.  
  5371. SI ((ZG_NEW >EG RHO0) ET (ZG_OLD >EG RHO0)) ;
  5372. TABLIG1.I0 = TABLIG1.I0 ET (((XM2 YM2 ZM2) D 1 (XM1 YM1 ZM1)) COUL ROUG);
  5373. SINON ;
  5374. TABLIG1.I0 = TABLIG1.I0 ET (((XM2 YM2 ZM2) D 1 (XM1 YM1 ZM1)) COUL JAUN);
  5375. FINSI ;
  5376. FINSI ;
  5377.  
  5378. TABLIG1.I0 = TABLIG1.I0 D 1 (XM1 YM1 ZM1) ;
  5379.  
  5380. XG_OLD = XG_NEW ;
  5381. YG_OLD = YG_NEW ;
  5382. ZG_OLD = ZG_NEW ;
  5383.  
  5384. MENAGE ;
  5385.  
  5386. FIN BOUCLE1 ;
  5387.  
  5388. * ---- calcul de l'erreur sur Rho
  5389.  
  5390. SI ((NON ISHIFT) ET (NON IRIPPLE)) ;
  5391. * ---- Coordonnees du point initial dans le repere
  5392. * ---- global du tore
  5393. XG0 YG0 ZG0 = @CRMGC XM0 YM0 ZM0 TAB1 ;
  5394.  
  5395. * ---- Coordonnees du point initial dans le repere
  5396. * ---- pseudo-toroidal du plasma
  5397. RHO0 THE0 PHI0 = @CRGTC XG0 YG0 ZG0 RP HP ;
  5398.  
  5399. * ---- Coordonnees du point final dans le repere
  5400. * ---- pseudo-toroidal du plasma
  5401. RHO1 THE1 PHI1 = @CRGTC XG_OLD YG_OLD ZG_OLD RP HP;
  5402.  
  5403. * ---- sans ripple, on doit avoir Rho constant le
  5404. * ---- long de la ligne de champ
  5405. DRHO0 = RHO1 - RHO0 ;
  5406. ERREUR0 = (ABS DRHO0) / RHO0 ;
  5407. MESS 'Variation en Rho : ' ; LIST DRHO0 ;
  5408. MESS 'Erreur en Rho : ' ; LIST ERREUR0 ;
  5409. FINSI ;
  5410.  
  5411. FIN BOUCLE0 ;
  5412. FINSI ;
  5413.  
  5414. SI (IMETHOD EGA 2) ;
  5415. * ---- Methode iterative avec convergence sur un critere
  5416. * ---- d'appartenance a la surface magnetique
  5417. I0 = 0 ;
  5418.  
  5419. REPETER BOUCLE0 (DIME LISTE0);
  5420.  
  5421. I0 = I0 + 1 ;
  5422. P0 = TEXT (EXTR I0 LISTE0) ;
  5423. XM YM ZM = COOR P0 ;
  5424. TABLIG1.I0 = ((XM+1.E-6) YM ZM) D 1 P0 ;
  5425.  
  5426. * ---- Transformation en champ par point
  5427. XM0 = MANU CHPO P0 1 SCAL XM ;
  5428. YM0 = MANU CHPO P0 1 SCAL YM ;
  5429. ZM0 = MANU CHPO P0 1 SCAL ZM ;
  5430.  
  5431. * ---- Coordonnees dans le repere global du tore
  5432. XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
  5433. *
  5434. I1 = 0 ;
  5435. REPETER BOUCLE1 NBPAS0 ;
  5436.  
  5437. I1 = I1 + 1 ; MESS 'I1 = ' I1;
  5438. * ---- Calcul du champ dans le repere global
  5439. BXG BYG BZG FSECU = @CHAMB TAB1 XG_OLD YG_OLD ZG_OLD ISHIFT IRIPPLE ;
  5440.  
  5441. NORM_B = ((BXG*BXG) + (BYG*BYG) + (BZG*BZG))**0.5 ;
  5442.  
  5443. XG_NEW0 = XG_OLD - (BXG * PASB0 / NORM_B) ;
  5444. YG_NEW0 = YG_OLD - (BYG * PASB0 / NORM_B) ;
  5445. ZG_NEW0 = ZG_OLD - (BZG * PASB0 / NORM_B) ;
  5446.  
  5447. * ---- Coordonnees dans le repere
  5448. * ---- pseudo-toroidal du ripple
  5449. RHOR THER PHIR = @CRGTC XG_OLD YG_OLD ZG_OLD RR 0.;
  5450.  
  5451. * ---- calcul de la coordonnee radiale dans le
  5452. * ---- plan meridien Phi=0 de la ligne de champ
  5453. * ---- consideree par une methode de point fixe
  5454. RHOR_OLD = RHOR ;
  5455. KAUX = (EXP(THER**2 * -1. * COEFC)) * ((COS (PHIR * NBOB)) * -1. + 1.) * COEFA ;
  5456. I3 = 0 ;
  5457. REPETER BOUCLE3 50 ;
  5458. I3 = I3 + 1; MESS ' I3 = ' I3;
  5459. RHOR_NEW = RHOR + (KAUX * (EXP(RHOR_OLD * COEFB)));
  5460. SI ((MAXI (ABS((RHOR_NEW - RHOR_OLD) / RHOR_NEW))) &lt;EG EPS0) ;
  5461. QUITTER BOUCLE3 ;
  5462. FINSI ;
  5463. RHOR_OLD = RHOR_NEW ;
  5464. FIN BOUCLE3 ;
  5465.  
  5466. RHOMER = RHOR_NEW ;
  5467.  
  5468. * ---- le point obtenu doit etre sur la surface magnetique
  5469. I2 = 0 ;
  5470. REPETER BOUCLE2 2 ;
  5471. I2 = I2 + 1 ; MESS ' I2 = ' I2;
  5472. * ---- Coordonnees dans le repere
  5473. * ---- pseudo-toroidal du ripple
  5474. RHORN THERN PHIRN = @CRGTC XG_NEW0 YG_NEW0 ZG_NEW0 RR 0.;
  5475.  
  5476. DRHOMERN = (EXP(RHOMER * COEFB)) * (EXP(THERN**2 * COEFC * -1.)) * COEFA ;
  5477.  
  5478. RHORIP = DRHOMERN * ((COS (PHIRN*NBOB)) - 1.) + RHOMER;
  5479.  
  5480. * ---- Coordonnees dans le repere global
  5481. XG_NEW1 YG_NEW1 ZG_NEW1 = @CRTGC RHORIP THERN PHIRN RR 0.;
  5482.  
  5483. * ---- Calcul du champ dans le repere global
  5484. BXG0 BYG0 BZG0 FSECU0 = @CHAMB TAB1 XG_NEW1 YG_NEW1 ZG_NEW1 ISHIFT IRIPPLE ;
  5485.  
  5486. * ---- on prend la moyenne des 2 tangentes
  5487. BXG1 = (BXG + BXG0)/2. ;
  5488. BYG1 = (BYG + BYG0)/2. ;
  5489. BZG1 = (BZG + BZG0)/2. ;
  5490.  
  5491. NORM_B1 = ((BXG1*BXG1) + (BYG1*BYG1) + (BZG1*BZG1))**0.5 ;
  5492.  
  5493. XG_NEW0 = XG_OLD - (BXG1 * PASB0 / NORM_B1) ;
  5494. YG_NEW0 = YG_OLD - (BYG1 * PASB0 / NORM_B1) ;
  5495. ZG_NEW0 = ZG_OLD - (BZG1 * PASB0 / NORM_B1) ;
  5496.  
  5497. SI (I2 EGA 2) ;
  5498. XG_NEW = XG_NEW0 ;
  5499. YG_NEW = YG_NEW0 ;
  5500. ZG_NEW = ZG_NEW0 ;
  5501. FINSI ;
  5502.  
  5503. FIN BOUCLE2 ;
  5504.  
  5505. * ---- Coordonnees dans le repere du maillage
  5506. XM_NEW YM_NEW ZM_NEW = @CRGMC XG_NEW YG_NEW ZG_NEW TAB1 ;
  5507.  
  5508. XG_OLD = XG_NEW ;
  5509. YG_OLD = YG_NEW ;
  5510. ZG_OLD = ZG_NEW ;
  5511.  
  5512. XM1 = EXTR XM_NEW SCAL P0 ;
  5513. YM1 = EXTR YM_NEW SCAL P0 ;
  5514. ZM1 = EXTR ZM_NEW SCAL P0;
  5515.  
  5516. TABLIG1.I0 = TABLIG1.I0 D 1 (XM1 YM1 ZM1) ;
  5517. MENAGE ;
  5518.  
  5519. FIN BOUCLE1 ;
  5520. FIN BOUCLE0 ;
  5521. FINSI ;
  5522. MESS '---------------------------------> exiting @CLIGB';
  5523. FINPROC ;
  5524.  
  5525. **** @CLIGB0
  5526. DEBPROC @CLIGB0 DPHI*FLOTTANT PHIMAX*FLOTTANT TAB1*TABLE TABLIG1*TABLE IMETHOD*ENTIER;
  5527. *
  5528. *****************************************************************
  5529. * Procedure de calcul des lignes de champ magnetique partant de *
  5530. * chaque point d'une geometrie donnee. *
  5531. * methode 1 : methode explicite (tangentes) *
  5532. * methode 2 : Runge-Kutta du 4eme ordre a pas constant *
  5533. * Alain MOAL (mars 1996) *
  5534. *****************************************************************
  5535. *
  5536. MESS '---------------------------------> calling @CLIGB';
  5537. *
  5538. *--------------- VARIABLES D'ENTREE :
  5539. LISTE0 = TAB1.<LI_LIGNE_B ;
  5540. OEIL0 = TAB1.VIEW_P ;
  5541. RP = TAB1.<RP ;
  5542. HP = TAB1.<HP ;
  5543. ANGPHI0 = TAB1.<ANG_PHI0 ;
  5544. TYPCAL = TAB1.<TYPE_CALCUL ;
  5545. *------------------------------------
  5546. *
  5547. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  5548. ISHIFT = VRAI ;
  5549. IRIPPLE = VRAI ;
  5550. FINSI ;
  5551. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  5552. ISHIFT = VRAI ;
  5553. IRIPPLE = FAUX ;
  5554. FINSI ;
  5555. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  5556. ISHIFT = FAUX ;
  5557. IRIPPLE = VRAI ;
  5558. FINSI ;
  5559. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  5560. ISHIFT = FAUX ;
  5561. IRIPPLE = FAUX ;
  5562. FINSI ;
  5563. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  5564. ERRE ' >>>> @CLIGB0 : check the value of TAB1.<TYPE_CALCUL';
  5565. FINSI ;
  5566.  
  5567. * ---- Valeurs par defaut
  5568. @VDEFAUT TAB1 ;
  5569. TABLIG1 = TABLE ;
  5570. *
  5571. SI (IMETHOD EGA 1) ;
  5572. * ---- Methode explicite (tangentes)
  5573. TEMPS ZERO ;
  5574. I0 = 0 ;
  5575. REPETER BOUCLE0 (DIME LISTE0);
  5576.  
  5577. I0 = I0 + 1 ;
  5578. P0 = TEXT (EXTR I0 LISTE0) ;
  5579. XM YM ZM = COOR P0 ;
  5580. TABLIG1.I0 = ((XM+1.E-6) YM ZM) D 1 P0 ;
  5581. *
  5582. * ---- Transformation en champ par point
  5583. XM0 = MANU CHPO P0 1 SCAL XM ;
  5584. YM0 = MANU CHPO P0 1 SCAL YM ;
  5585. ZM0 = MANU CHPO P0 1 SCAL ZM ;
  5586. DPHI0 = MANU CHPO P0 1 SCAL DPHI ;
  5587. *
  5588. * ---- Coordonnees dans le repere global du tore
  5589. XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
  5590. *
  5591. LISTRHO = PROG ;
  5592. LISTTHE = PROG ;
  5593. LISTPHI = PROG ;
  5594. LISTFSE = PROG ;
  5595. *
  5596. PHIAUX = ANGPHI0 ;
  5597. *
  5598. REPETER BOUCLE1 (ENTI (PHIMAX/DPHI)) ;
  5599. *
  5600. PHIAUX = PHIAUX + DPHI ;
  5601. * ---- Numero du grand tour calcule a partir du plan
  5602. * ---- median entre bobines
  5603. NTOUR0 = (ENTI (PHIAUX / 360.)) + 1 ;
  5604. *
  5605. * ---- Calcul du champ dans le repere global
  5606. BX BY BZ FSECU = @CHAMB TAB1 XG_OLD YG_OLD ZG_OLD ISHIFT IRIPPLE ;
  5607. *
  5608. * ---- Coordonnees dans le repere pseudo-toroidal du plasma
  5609. RHO_OLD THE_OLD PHI_OLD = @CRGTC XG_OLD YG_OLD ZG_OLD RP HP ;
  5610. *
  5611. * ---- Champ dans le repere pseudo-toroidal du plasma
  5612. BRHO BTHETA BPHI = @CBGTV BX BY BZ THE_OLD PHI_OLD ;
  5613. *
  5614. DRHO0 = (RHO_OLD * (COS THE_OLD) + RP) * BRHO * DPHI0 / BPHI;
  5615. DTHE0 = (RHO_OLD * (COS THE_OLD) + RP) * BTHETA * DPHI0 / BPHI / RHO_OLD;
  5616.  
  5617. RHO_NEW = RHO_OLD + DRHO0 ;
  5618. THE_NEW = THE_OLD + DTHE0 ;
  5619. * MESS 'PHI_OLD+DPHI0 '; LIST (MAXI (PHI_OLD+DPHI0));
  5620. SI (((MAXI (PHI_OLD+DPHI0)) >EG 0.) ET ((MAXI (PHI_OLD+DPHI0)) &lt;EG 180.));
  5621. PHI_NEW = PHI_OLD + DPHI0 + (360. * (NTOUR0-1));
  5622. FINSI ;
  5623. SI (((MAXI (PHI_OLD+DPHI0)) > -180.) ET ((MAXI (PHI_OLD+DPHI0)) < 0.));
  5624. PHI_NEW = PHI_OLD + DPHI0 + (360. * NTOUR0) ;
  5625. FINSI ;
  5626. SI ((MAXI (PHI_OLD+DPHI0)) > 180.) ;
  5627. PHI_NEW = PHI_OLD + DPHI0 ;
  5628. FINSI ;
  5629.  
  5630. LISTRHO = LISTRHO ET (PROG (MAXI RHO_NEW)) ;
  5631. LISTTHE = LISTTHE ET (PROG (MAXI THE_NEW)) ;
  5632. LISTPHI = LISTPHI ET (PROG (MAXI PHI_NEW)) ;
  5633. LISTFSE = LISTFSE ET (PROG (MAXI FSECU)) ;
  5634. *
  5635. * ---- Coordonnees dans le repere global
  5636. XG_NEW YG_NEW ZG_NEW = @CRTGC RHO_NEW THE_NEW PHI_NEW RP HP;
  5637. *
  5638. MESS 'TOUR : ' ; LIST NTOUR0 ;
  5639. MESS 'MAX DE PHI '; LIST (MAXI PHI_NEW);
  5640. MESS 'MAX DE RHO '; LIST (MAXI RHO_NEW);
  5641. MESS 'MAX DE THE '; LIST (MAXI THE_NEW);
  5642. MESS 'MAX DE FSECU '; LIST (MAXI FSECU);
  5643.  
  5644. * MESS 'MAX DE BPHI '; LIST (MAXI BPHI);
  5645. * MESS 'MAX DE BRHO '; LIST (MAXI BRHO);
  5646. * MESS 'MAX DE BTHE '; LIST (MAXI BTHETA);
  5647.  
  5648. * ---- Coordonnees dans le repere du maillage
  5649. XM_NEW YM_NEW ZM_NEW = @CRGMC XG_NEW YG_NEW ZG_NEW TAB1 ;
  5650. *
  5651. XG_OLD = XG_NEW ;
  5652. YG_OLD = YG_NEW ;
  5653. ZG_OLD = ZG_NEW ;
  5654.  
  5655. XM1 = EXTR XM_NEW SCAL P0 ;
  5656. YM1 = EXTR YM_NEW SCAL P0 ;
  5657. ZM1 = EXTR ZM_NEW SCAL P0;
  5658.  
  5659. TABLIG1.I0 = TABLIG1.I0 D 1 (XM1 YM1 ZM1) ;
  5660.  
  5661. SI ((MAXI PHI_NEW) >EG PHIMAX) ;
  5662. MESS '>>>> The maximum value of Phi is reached';
  5663. QUITTER BOUCLE1 ;
  5664. FINSI ;
  5665. MENAGE ;
  5666.  
  5667. FIN BOUCLE1 ;
  5668.  
  5669. EVRHO = EVOL JAUN MANU 'PHI' LISTPHI 'RHO' LISTRHO ;
  5670. EVTHE = EVOL ROUG MANU 'PHI' LISTPHI 'THETA' LISTTHE ;
  5671. EVFSE = EVOL VERT MANU 'PHI' LISTPHI 'FSECU' LISTFSE ;
  5672. DESSIN EVRHO MIMA ;
  5673. DESSIN EVTHE MIMA ;
  5674. DESSIN EVFSE MIMA ;
  5675. FIN BOUCLE0 ;
  5676. TEMPS ;
  5677. FINSI ;
  5678.  
  5679. SI (IMETHOD EGA 2) ;
  5680. * ---- Runge-Kutta d'ordre 4 a pas constant
  5681. TEMPS ZERO ;
  5682. I0 = 0 ;
  5683. REPETER BOUCLE0 (DIME LISTE0);
  5684.  
  5685. I0 = I0 + 1 ;
  5686. P0 = TEXT (EXTR I0 LISTE0) ;
  5687. XM YM ZM = COOR P0 ;
  5688. TABLIG1.I0 = ((XM+1.E-6) YM ZM) D 1 P0 ;
  5689. *
  5690. * ---- Transformation en champ par point
  5691. XM0 = MANU CHPO P0 1 SCAL XM ;
  5692. YM0 = MANU CHPO P0 1 SCAL YM ;
  5693. ZM0 = MANU CHPO P0 1 SCAL ZM ;
  5694. DPHI0 = MANU CHPO P0 1 SCAL DPHI ;
  5695. *
  5696. * ---- Coordonnees dans le repere global du tore
  5697. XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
  5698. *
  5699. LISTRHO = PROG ;
  5700. LISTTHE = PROG ;
  5701. LISTPHI = PROG ;
  5702. LISTFSE = PROG ;
  5703. *
  5704. PHIAUX = ANGPHI0 ;
  5705. *
  5706. REPETER BOUCLE1 (ENTI (PHIMAX/DPHI)) ;
  5707. *
  5708. PHIAUX = PHIAUX + DPHI ;
  5709. * ---- Numero du grand tour calcule a partir du plan
  5710. * ---- median entre bobine
  5711. NTOUR0 = (ENTI (PHIAUX / 360.)) + 1 ;
  5712. *
  5713. * ---- Calcul du champ dans le repere global
  5714. BX BY BZ FSECU = @CHAMB TAB1 XG_OLD YG_OLD ZG_OLD ISHIFT IRIPPLE ;
  5715.  
  5716. * ---- Coordonnees dans le repere pseudo-toroidal du plasma
  5717. RHO_OLD THE_OLD PHI_OLD = @CRGTC XG_OLD YG_OLD ZG_OLD RP HP ;
  5718.  
  5719. * ---- Champ dans le repere pseudo-toroidal du plasma
  5720. BRHO BTHE BPHI = @CBGTV BX BY BZ THE_OLD PHI_OLD ;
  5721. *
  5722. * ---- calcul de K0 et L0
  5723. K0 = (RHO_OLD * (COS THE_OLD) + RP) * BRHO / BPHI;
  5724. L0 = (RHO_OLD * (COS THE_OLD) + RP) * BTHE / BPHI / RHO_OLD;
  5725.  
  5726. * ---- calcul de K1 et L1
  5727. RHO1_OLD = RHO_OLD + (K0/2.) ;
  5728. THE1_OLD = THE_OLD + (L0/2.) ;
  5729. * SI (((MAXI (PHI_OLD+DPHI0)) >EG 0.) ET
  5730. * ((MAXI (PHI_OLD+DPHI0)) &lt;EG 180.));
  5731. * PHI1_OLD = PHI_OLD + (DPHI0/2.) + (360. * (NTOUR0-1));
  5732. * FINSI ;
  5733. * SI (((MAXI (PHI_OLD+DPHI0)) > -180.) ET
  5734. * ((MAXI (PHI_OLD+DPHI0)) < 0.));
  5735. * PHI1_OLD = PHI_OLD + (DPHI0/2.) + (360. * NTOUR0) ;
  5736. * FINSI ;
  5737. * SI ((MAXI (PHI_OLD+DPHI0)) > 180.) ;
  5738. PHI1_OLD = PHI_OLD + (DPHI0/2) ;
  5739. * FINSI ;
  5740.  
  5741. XG1_OLD YG1_OLD ZG1_OLD = @CRTGC RHO1_OLD THE1_OLD PHI1_OLD RP HP;
  5742.  
  5743. * ---- Calcul du champ dans le repere global
  5744. BX1 BY1 BZ1 FSECU = @CHAMB TAB1 XG1_OLD YG1_OLD ZG1_OLD IRIPPLE ISHIFT ;
  5745.  
  5746. * ---- Champ dans le repere pseudo-toroidal du plasma
  5747. BRHO1 BTHE1 BPHI1 = @CBGTV BX1 BY1 BZ1 THE1_OLD PHI1_OLD ;
  5748.  
  5749. K1 = (RHO1_OLD * (COS THE1_OLD) + RP)*BRHO1 /BPHI1 * DPHI0;
  5750. L1 = (RHO1_OLD * (COS THE1_OLD) + RP)*BTHE1/BPHI1 / RHO1_OLD * DPHI0;
  5751.  
  5752. * ---- calcul de K2 et L2
  5753. RHO2_OLD = RHO_OLD + (K1/2.) ;
  5754. THE2_OLD = THE_OLD + (L1/2.) ;
  5755. * SI (((MAXI (PHI_OLD+DPHI0)) >EG 0.) ET
  5756. * ((MAXI (PHI_OLD+DPHI0)) &lt;EG 180.));
  5757. * PHI2_OLD = PHI_OLD + (DPHI0/2.) + (360. * (NTOUR0-1));
  5758. * FINSI ;
  5759. * SI (((MAXI (PHI_OLD+DPHI0)) > -180.) ET
  5760. * ((MAXI (PHI_OLD+DPHI0)) < 0.));
  5761. * PHI2_OLD = PHI_OLD + (DPHI0/2.) + (360. * NTOUR0);
  5762. * FINSI ;
  5763. * SI ((MAXI (PHI_OLD+DPHI0)) > 180.) ;
  5764. PHI2_OLD = PHI_OLD + (DPHI0/2) ;
  5765. * FINSI ;
  5766.  
  5767. XG2_OLD YG2_OLD ZG2_OLD = @CRTGC RHO2_OLD THE2_OLD PHI2_OLD RP HP;
  5768.  
  5769. * ---- Calcul du champ dans le repere global
  5770. BX2 BY2 BZ2 FSECU = @CHAMB TAB1 XG2_OLD YG2_OLD ZG2_OLD ISHIFT IRIPPLE ;
  5771.  
  5772. * ---- Champ dans le repere pseudo-toroidal du plasma
  5773. BRHO2 BTHE2 BPHI2 = @CBGTV BX2 BY2 BZ2 THE2_OLD PHI2_OLD ;
  5774.  
  5775. K2 = (RHO2_OLD * (COS THE2_OLD) + RP)*BRHO2 /BPHI2 * DPHI0;
  5776. L2 = (RHO2_OLD * (COS THE2_OLD) + RP)*BTHE2/BPHI2 / RHO2_OLD * DPHI0;
  5777.  
  5778. * ---- calcul de K3 et L3
  5779. RHO3_OLD = RHO_OLD + K2 ;
  5780. THE3_OLD = THE_OLD + L2 ;
  5781. * SI (((MAXI (PHI_OLD+DPHI0)) >EG 0.) ET
  5782. * ((MAXI (PHI_OLD+DPHI0)) &lt;EG 180.));
  5783. * PHI3_OLD = PHI_OLD + DPHI0 + (360. * (NTOUR0-1));
  5784. * FINSI ;
  5785. * SI (((MAXI (PHI_OLD+DPHI0)) > -180.) ET
  5786. * ((MAXI (PHI_OLD+DPHI0)) < 0.));
  5787. * PHI3_OLD = PHI_OLD + DPHI0 + (360. * NTOUR0);
  5788. * FINSI ;
  5789. * SI ((MAXI (PHI_OLD+DPHI0)) > 180.) ;
  5790. PHI3_OLD = PHI_OLD + DPHI0 ;
  5791. * FINSI ;
  5792.  
  5793. XG3_OLD YG3_OLD ZG3_OLD = @CRTGC RHO3_OLD THE3_OLD PHI3_OLD RP HP;
  5794.  
  5795. * ---- Calcul du champ dans le repere global
  5796. BX3 BY3 BZ3 FSECU = @CHAMB TAB1 XG3_OLD YG3_OLD ZG3_OLD ISHIFT IRIPPLE ;
  5797.  
  5798. * ---- Champ dans le repere pseudo-toroidal du plasma
  5799. BRHO3 BTHE3 BPHI3 = @CBGTV BX3 BY3 BZ3 THE3_OLD PHI3_OLD ;
  5800.  
  5801. K3 = (RHO3_OLD * (COS THE3_OLD) + RP)*BRHO3 / BPHI3 * DPHI0;
  5802. L3 = (RHO3_OLD * (COS THE3_OLD) + RP)*BTHE3/BPHI3 / RHO3_OLD * DPHI0;
  5803.  
  5804. RHO_NEW = RHO_OLD + ((K0 + (2.*K1) + (2.*K2) + K3)/6.);
  5805. THE_NEW = THE_OLD + ((L0 + (2.*L1) + (2.*L2) + L3)/6.);
  5806.  
  5807. SI (((MAXI (PHI_OLD+DPHI0)) >EG 0.) ET ((MAXI (PHI_OLD+DPHI0)) &lt;EG 180.));
  5808. PHI_NEW = PHI_OLD + DPHI0 + (360. * (NTOUR0-1));
  5809. FINSI ;
  5810. SI (((MAXI (PHI_OLD+DPHI0)) > -180.) ET ((MAXI (PHI_OLD+DPHI0)) < 0.));
  5811. PHI_NEW = PHI_OLD + DPHI0 + (360. * NTOUR0) ;
  5812. FINSI ;
  5813. SI ((MAXI (PHI_OLD+DPHI0)) > 180.) ;
  5814. PHI_NEW = PHI_OLD + DPHI0 ;
  5815. FINSI ;
  5816.  
  5817. LISTRHO = LISTRHO ET (PROG (MAXI RHO_NEW)) ;
  5818. LISTTHE = LISTTHE ET (PROG (MAXI THE_NEW)) ;
  5819. LISTPHI = LISTPHI ET (PROG (MAXI PHI_NEW)) ;
  5820. LISTFSE = LISTFSE ET (PROG (MAXI FSECU)) ;
  5821.  
  5822. * ---- Coordonnees dans le repere global
  5823. XG_NEW YG_NEW ZG_NEW = @CRTGC RHO_NEW THE_NEW PHI_NEW RP HP;
  5824. MESS 'TOUR : ' ; LIST NTOUR0 ;
  5825. MESS 'MAX DE PHI '; LIST (MAXI PHI_NEW);
  5826. MESS 'MAX DE RHO '; LIST (MAXI RHO_NEW);
  5827. MESS 'MAX DE THE '; LIST (MAXI THE_NEW);
  5828. MESS 'MAX DE FSECU '; LIST (MAXI FSECU);
  5829.  
  5830. * ---- Coordonnees dans le repere du maillage
  5831. XM_NEW YM_NEW ZM_NEW = @CRGMC XG_NEW YG_NEW ZG_NEW TAB1 ;
  5832. *
  5833. XG_OLD = XG_NEW ;
  5834. YG_OLD = YG_NEW ;
  5835. ZG_OLD = ZG_NEW ;
  5836.  
  5837. XM1 = EXTR XM_NEW SCAL P0 ;
  5838. YM1 = EXTR YM_NEW SCAL P0 ;
  5839. ZM1 = EXTR ZM_NEW SCAL P0;
  5840.  
  5841. TABLIG1.I0 = TABLIG1.I0 D 1 (XM1 YM1 ZM1) ;
  5842.  
  5843. SI ((MAXI PHI_NEW) >EG PHIMAX) ;
  5844. MESS '>>>> The maximum value of Phi is reached';
  5845. QUITTER BOUCLE1 ;
  5846. FINSI ;
  5847. MENAGE ;
  5848.  
  5849. FIN BOUCLE1 ;
  5850.  
  5851. EVRHO = EVOL JAUN MANU 'PHI' LISTPHI 'RHO' LISTRHO ;
  5852. EVTHE = EVOL ROUG MANU 'PHI' LISTPHI 'THETA' LISTTHE ;
  5853. EVFSE = EVOL VERT MANU 'PHI' LISTPHI 'FSECU' LISTFSE ;
  5854. DESSIN EVRHO MIMA ;
  5855. DESSIN EVTHE MIMA ;
  5856. DESSIN EVFSE MIMA ;
  5857. FIN BOUCLE0 ;
  5858. TEMPS ;
  5859. FINSI ;
  5860.  
  5861. MESS '---------------------------------> exiting @CLIGB0';
  5862. FINPROC ;
  5863.  
  5864. **** CONTACT
  5865. *---------------------------------------------------------------------
  5866. * PROCEDURE CONTACT VERSION DU 15/10/87
  5867. *---------------------------------------------------------------------
  5868. * CETTE PROCEDURE SERT A DEFINIR LE CONTACT ENTRE 2 SOLIDES
  5869. * OU ENTRE 1 SOLIDE ET UN OBSTACLE .
  5870. *
  5871. * SYNTAXE :
  5872. * -------
  5873. *
  5874. *
  5875. * BLC BLT FFF COEF =
  5876. *
  5877. * CONTACT | MINI | NOMINC | POI1 ( POI2 ) |
  5878. * | MAXI | DIRECTION V1 | GEO1 ( GEO2 ) |
  5879. *
  5880. * | CONSTANT | MU ( JEU | VVAL | ) ;
  5881. * | COULOMB | | CHSCA |
  5882. * | CHP |
  5883. *
  5884. *
  5885. * ATTENTION METTRE LES NOMS CONNUS EN 4 LETTRES |
  5886. * EXEMPLE : METTRE DIRE ET NON PAS DIRECTION
  5887. *
  5888. * ( EXPLICATION : CF BLOQUER , RELA ET DEPI )
  5889. *
  5890. * BLC ET BLT: LES BLOCAGES ASSOCIES AU CONTACT
  5891. * ( NORMAUX ET TANGENTIELS )
  5892. * FFF : LE SECOND MEMBRE ( NON NUL SI JEU )
  5893. * COEF : LES COEFFICIENTS DE FROTTEMENT
  5894. *
  5895. *---------------------------------------------------------------------
  5896. DEBPROC CONTACT MOMIN*MOT DDL*MOT V1/POINT POI1/POINT POI2/POINT MA1/MAILLAGE MA2/MAILLAGE MFRO*MOT ZFRO*FLOTTANT MJEU/MOT VVAL/FLOTTANT VCHP/CHPOINT ;
  5897. *
  5898. IDIR = 0 ;
  5899. SSDIM = VALE DIME ;
  5900. SI ( EGA DDL DIRE ) ;
  5901. IDIR = 1 ; FINSI ;
  5902. *------------------------------
  5903. * ON RECUPERE LA GEOMETRIE
  5904. *------------------------------
  5905. IDEUX = 0 ;
  5906. SI ( EGA IDIR 0 ) ;
  5907. SI ( EXISTE V1 ) ;
  5908. GEO1 = V1 ;
  5909. SI ( EXISTE POI1 ) ;
  5910. IDEUX = 1 ;
  5911. GEO2 = POI1 ;
  5912. FINSI ;
  5913. FINSI ;
  5914. SINON ;
  5915. SI ( EXISTE POI1 ) ;
  5916. GEO1 = POI1 ;
  5917. SI ( EXISTE POI2 ) ;
  5918. IDEUX = 1 ;
  5919. GEO2 = POI2 ;
  5920. FINSI ;
  5921. FINSI;
  5922. FINSI ;
  5923. SI ( EXISTE MA1 ) ;
  5924. GEO1 = MA1 ;
  5925. FINSI ;
  5926. SI ( EXISTE MA2 ) ;
  5927. IDEUX = 1 ;
  5928. GEO2 = MA2 ;
  5929. FINSI ;
  5930. SI ( EGA IDEUX 1 ) ;
  5931. GEO = GEO1 ET GEO2 ; SINON ;
  5932. GEO = GEO1 ;
  5933. FINSI ;
  5934. *
  5935. *------------------------------
  5936. * ON RECUPERE LA DIRECTION
  5937. *------------------------------
  5938. SI ( EGA IDIR 1 ) ;
  5939. IDIR = 1 ;
  5940. SI ( EGA SSDIM 2 ) ;
  5941. V1X V1Y = COOR V1 ;
  5942. V2 = V1Y ( 0 - V1X ) ;
  5943. SINON ;
  5944. V1X V1Y V1Z = COOR V1 ;
  5945. V2X = 0. - V1Y ;
  5946. V2Y = V1X ;
  5947. V2Z = 0. ;
  5948. V2 = V2X V2Y V2Z ;
  5949. V2NOR = NORM V2 ;
  5950. SI ( EGA V2NOR 0. ) ;
  5951. V2 = 0. ( 0. - V1Z ) V1Y ;
  5952. FINSI ;
  5953. V3 = PVECT V1 V2 ;
  5954. FINSI ;
  5955. SINON ;
  5956. SI ( EGA DDL UX ) ;
  5957. SI ( EGA SSDIM 2 ) ;
  5958. V1 = 1 0 ;
  5959. V2 = 0 -1 ;
  5960. SINON ;
  5961. V1 = 1 0 0 ;
  5962. V2 = 0 1 0 ;
  5963. V3 = 0 0 1 ;
  5964. FINSI ;
  5965. FINSI ;
  5966. SI ( EGA DDL UY ) ;
  5967. SI ( EGA SSDIM 2 ) ;
  5968. V1 = 0 1 ;
  5969. V2 = 1 0 ;
  5970. SINON ;
  5971. V1 = 0 1 0 ;
  5972. V2 = 0 0 1;
  5973. V3 = 1 0 0 ;
  5974. FINSI ;
  5975. FINSI ;
  5976. SI ( EGA DDL UR ) ;
  5977. V1 = 1 0 ;
  5978. V2 = 0 1 ;
  5979. FINSI ;
  5980. SI ( EGA DDL UZ ) ;
  5981. SI ( EGA SSDIM 2 ) ;
  5982. V1 = 0 1 ;
  5983. V2 = 1 0 ;
  5984. SINON ;
  5985. V1 = 0 0 1 ;
  5986. V2 = 1 0 0;
  5987. V3 = 0 1 0 ;
  5988. FINSI ;
  5989. FINSI ;
  5990. FINSI ;
  5991. *-----------------------
  5992. * ON RECUPERE LE JEU
  5993. *-----------------------
  5994. IJEU = 0 ;
  5995. SI ( EXISTE MJEU ) ;
  5996. IJEU = 1 ;
  5997. SI ( EXISTE VVAL ) ;
  5998. VJEU = VVAL ;
  5999. FINSI ;
  6000. SI ( EXISTE VCHP ) ;
  6001. VJEU = VCHP ;
  6002. FINSI ;
  6003. FINSI ;
  6004. *--------------------------
  6005. * ON CREE LES BLOCAGES
  6006. *--------------------------
  6007. *
  6008. SI ( EGA IDEUX 0 ) ;
  6009. BLC = BLOQUE MOMIN DEPL DIRECTION V1 GEO1 ;
  6010. BLT = BLOQUE FROT DEPL DIRECTION V2 GEO1 ;
  6011. SI ( EGA SSDIM 3 ) ;
  6012. BLT = BLT ET ( BLOQUE FROT DEPL DIRECTION V3 GEO1 ) ;
  6013. FINSI ;
  6014. SINON ;
  6015. BLC = RELA MOMIN DEPL DIREC V1 GEO1 - DEPL DIREC V1 GEO2 ;
  6016. BLT = RELA FROT DEPL DIREC V2 GEO1 - DEPL DIREC V2 GEO2 ;
  6017. SI ( EGA SSDIM 3 ) ;
  6018. BLT = BLT ET ( RELA FROT DEPL DIREC V3 GEO1 - DEPL DIREC V3 GEO2 ) ;
  6019. FINSI ;
  6020. FINSI ;
  6021. *BLOCAG = BLC ET BLT ;
  6022. *-------------------------------------------
  6023. * ON CALCULE LES FORCES AU SECOND MEMBRE
  6024. *-------------------------------------------
  6025. SI ( EGA IJEU 1 ) ;
  6026. SI ( EGA MOMIN MAXI ) ;
  6027. FAC = 1.;
  6028. SINON ;
  6029. FAC = -1. ;
  6030. FINSI ;
  6031. FFF = DEPI BLC ( FAC * VJEU ) ;
  6032. SINON ;
  6033. FFF = MANU CHPO GEO 1 FLX 0. ;
  6034. FINSI ;
  6035. *---------------------------------------------
  6036. * ON CALCULE LES COEFFICIENTS DE FROTTEMENT
  6037. *---------------------------------------------
  6038. GEOT = EXTR BLT MAIL MULT ;
  6039. COEF = MANU CHPO GEOT 1 MFRO ZFRO ;
  6040. *----------------------------------------------------------------------
  6041. * SORTIE DE LA PROCEDURE
  6042. *----------------------------------------------------------------------
  6043. FINPROC BLC BLT FFF COEF ;
  6044. * 1 2 3 4 5 6 7*
  6045. *123456789012345678901234567890123456789012345678901234567890123456789012
  6046. * *
  6047. * *
  6048. * *
  6049. DEBPROC CONTRAPH LIGN_1*MAILLAGE INSTEVOL*FLOTTANT MOD1*MMODEL TAB1*TABLE SM1/EVOLUTION SM2/EVOLUTION VAL1/FLOTTANT;
  6050.  
  6051. MESS '-----------------------------------> entree dans CONTRAPH ' ;
  6052.  
  6053. DIM1 = VALEUR DIME ;
  6054. * test sur la dimension
  6055. SI (EGA DIM1 2) ;
  6056. MESS ' attention au SMZZ en 2D' ;
  6057. SINON ;
  6058. MESS ' !!! ATTENTION !!! en 3 D ' ;
  6059. MESS ' utilisation a vos risques et perils a cause du fonctionement incertain de PROI ' ;
  6060. MESS ' la remarque est sans objet si LIGN_1 appartient au maillage ';
  6061. FINSI;
  6062.  
  6063.  
  6064. SI (NON (EXISTE TAB1 RESUCONT)) ;
  6065. MESS ' TAB1 NE CONTIENT PAS DE CONTRAINTES ' ;
  6066. MESS ' SORTIE DE CONTRAPH ' ;
  6067. QUITTER CONTRAPH ;
  6068. FINSI ;
  6069.  
  6070. * test sur la dimension de LIGN_1*MAILLAGE : a faire
  6071.  
  6072. LCONFON = FAUX ;
  6073. MAIL_1 = MOD1 EXTR 'MAIL' ;
  6074. N_1 = NBNO MAIL_1 ;
  6075. N_2 = NBNO (MAIL_1 ET LIGN_1 ) ;
  6076.  
  6077. SI ( EGA N_1 N_2 ) ;
  6078. LCONFON = VRAI ;
  6079. FINSI ;
  6080.  
  6081. SI (NON(EXISTE TAB1 TETMAT)) ;
  6082. MESS ' TAB1 NE CONTIENT PAS DE TETMAT ' ;
  6083. MESS ' SORTIE DE CONTRAPH ' ;
  6084. QUITTER CONTRAPH ;
  6085. FINSI ;
  6086.  
  6087. SI (NON(EXISTE (TAB1.TETMAT) MOD1)) ;
  6088. MESS ' TAB1.TETMAT NE CONTIENT PAS DE MODELE ' ;
  6089. MESS ' SORTIE DE CONTRAPH ' ;
  6090. QUITTER CONTRAPH ;
  6091. FINSI ;
  6092.  
  6093. SI (NON(EXISTE (TAB1.TETMAT.MOD1) SIGY)) ;
  6094. MESS ' LE MATERIAU DEMANDE N EST PAS PLASTIQUE ' ;
  6095. MESS ' SORTIE DE CONTRAPH ' ;
  6096. QUITTER CONTRAPH ;
  6097. FINSI ;
  6098.  
  6099. L1TITR = CHAIN 'DEPOUILLEMENT LE LONG DE LA LIGNE A' INSTEVOL ;
  6100. TITR L1TITR ;
  6101.  
  6102. LIMELAS1 = VARI TAB1.CHPOTHETA.INSTEVOL TAB1.TETMAT.MOD1.'SIGY' ;
  6103.  
  6104. SI (EXISTE SM1) ;
  6105. LIMSM1 = VARI TAB1.CHPOTHETA.INSTEVOL SM1 ;
  6106. FINSI ;
  6107. SI (EXISTE SM2) ;
  6108. LIMSM2 = VARI TAB1.CHPOTHETA.INSTEVOL SM2 ;
  6109. FINSI ;
  6110. VMIS1 = VMIS MOD1 TAB1.RESUCONT. INSTEVOL ;
  6111.  
  6112. CHEP4 = EXCO TAB1.RESUVARI.INSTEVOL EPSE ;
  6113. CHEP3 = REDU CHEP4 MOD1 ;
  6114. CHEP2 = (CHAN NOEUD CHEP3 MOD1 );
  6115.  
  6116. SI LCONFON ;
  6117. CHVM1 = CHAN 'CHPO' MOD1 (CHAN NOEUD MOD1 VMIS1) ;
  6118. LIMELAS2 = LIMELAS1 ;
  6119. CHEP1 = CHAN 'CHPO' MOD1 CHEP2 ;
  6120. SI (EXISTE SM1 ) ;
  6121. LIM2SM1 = LIMSM1 ;
  6122. FINSI ;
  6123. SI (EXISTE SM2 ) ;
  6124. LIM2SM2 = LIMSM2 ;
  6125. FINSI ;
  6126. SINON ;
  6127. CHVM1 = PROI LIGN_1 (CHAN NOEUD MOD1 VMIS1) ;
  6128. LIMELAS2 = PROI LIGN_1 (CHAN CHAM LIMELAS1 MOD1 NOEUD) ;
  6129. CHEP1 = PROI LIGN_1 CHEP2 ;
  6130. SI (EXISTE SM1) ;
  6131. LIM2SM1 = PROI LIGN_1 (CHAN CHAM LIMSM1 MOD1 NOEUD) ;
  6132. FINSI ;
  6133. SI (EXISTE SM2) ;
  6134. LIM2SM2 = PROI LIGN_1 (CHAN CHAM LIMSM2 MOD1 NOEUD) ;
  6135. FINSI ;
  6136. FINSI ;
  6137.  
  6138. TAC1 = TABLE ;
  6139. EVVM1 = EVOL ROUG CHPO CHVM1 LIGN_1 ;
  6140. EVEL1 = EVOL BLEU CHPO LIMELAS2 LIGN_1 ;
  6141. * champs dde t le long de la ligne
  6142. TCHAM = CHAN CHAM (TAB1.CHPOTHETA.INSTEVOL) MOD1 NOEUD ;
  6143. PTCH = PROI TCHAM LIGN_1 ;
  6144. EVTE1 = EVOL JAUN CHPO (PTCH * 1.E6) 'T' LIGN_1 ;
  6145. TAC1.1 = CHAI 'MARQ CARR REGU TITR V_MISES ' ;
  6146. TAC1.3 = CHAI 'MARQ LOSA REGU TITR LIM_ELAS' ;
  6147. TAC1.5 = CHAI 'MARQ CROI REGU TITR TEMPERAT' ;
  6148. EV_OTT = EVVM1 ET EVEL1 ET EVTE1 ;
  6149.  
  6150. SI (EXISTE SM1) ;
  6151. EVRU1 = EVOL TURQ CHPO LIM2SM1 LIGN_1 ;
  6152. TAC1.7 = CHAI 'MARQ TRIA REGU TITR SM' ;
  6153. SI (EXISTE SM2) ;
  6154. EVRU2 = EVOL VERT CHPO LIM2SM2 LIGN_1 ;
  6155. TAC1.9 = CHAI 'MARQ TRIB REGU TITR 3SM_ou_RM' ;
  6156. SI (EXISTE VAL1) ;
  6157. EVVA1 = EVOL CHPO VAL1 LIGN_1 ;
  6158. TAC1.11 = CHAI 'MARQ ETOI REGU TITR VALEUR' ;
  6159. EV_OTT = EV_OTT ET EVRU1 ET EVRU2 ET EVVA1 ;
  6160. SINON ;
  6161. EV_OTT = EV_OTT ET EVRU1 ET EVRU2 ;
  6162. FINSI ;
  6163. SINON ;
  6164. SI (EXISTE VAL1) ;
  6165. EVVA1 = EVOL CHPO VAL1 LIGN_1 ;
  6166. TAC1.9 = CHAI 'MARQ ETOI REGU TITR VALEUR' ;
  6167. EV_OTT = EV_OTT ET EVRU1 ET EVVA1 ;
  6168. FINSI ;
  6169. *tc ajout d'un finsi ???
  6170. 'FINSI' ;
  6171. SINON ;
  6172. SI (EXISTE VAL1 ) ;
  6173. EVVA1 = EVOL CHPO VAL1 LIGN_1 ;
  6174. TAC1.7 = CHAI 'MARQ ETOI REGU TITR VALEUR' ;
  6175. EV_OTT = EV_OTT ET EVVA1 ;
  6176. FINSI ;
  6177. FINSI ;
  6178.  
  6179. DESS EV_OTT LEGE MIMA TAC1 ;
  6180.  
  6181. MESS '-----------------------------------> sortie de CONTRAPH ' ;
  6182.  
  6183. FINPROC ;
  6184. **** @COUTOR1
  6185. *****************************************************************
  6186. * PROCEDURE @COUTOR1 :
  6187. *****************************************************************
  6188.  
  6189. DEBPROC @COUTOR1 IEL*MAILLAGE CHT*CHPOINT CHN*CHPOINT CHB*CHPOINT ;
  6190. PI = 3.14159 ;
  6191. P2 = IEL POIN INITIAL ;
  6192. P3 = IEL POIN FINAL ;
  6193. DIMGEO1 = VALEUR DIME ;
  6194. SI (DIMGEO1 > 2);
  6195. NXI2 = EXTR CHN NX P2 ;
  6196. NYI2 = EXTR CHN NY P2 ;
  6197. NZI2 = EXTR CHN NZ P2 ;
  6198. VN2 = NXI2 NYI2 NZI2 ;
  6199. TXI2 = EXTR CHT TX P2 ;
  6200. TYI2 = EXTR CHT TY P2 ;
  6201. TZI2 = EXTR CHT TZ P2 ;
  6202. VT2 = TXI2 TYI2 TZI2 ;
  6203. BXI2 = EXTR CHB BX P2 ;
  6204. BYI2 = EXTR CHB BY P2 ;
  6205. BZI2 = EXTR CHB BZ P2 ;
  6206. VB2 = BXI2 BYI2 BZI2 ;
  6207. NXI3 = EXTR CHN NX P3 ;
  6208. NYI3 = EXTR CHN NY P3 ;
  6209. NZI3 = EXTR CHN NZ P3 ;
  6210. VN3 = NXI3 NYI3 NZI3 ;
  6211. TXI3 = EXTR CHT TX P3 ;
  6212. TYI3 = EXTR CHT TY P3 ;
  6213. TZI3 = EXTR CHT TZ P3 ;
  6214. VT3 = TXI3 TYI3 TZI3 ;
  6215. BXI3 = EXTR CHB BX P3 ;
  6216. BYI3 = EXTR CHB BY P3 ;
  6217. BZI3 = EXTR CHB BZ P3 ;
  6218. VB3 = BXI3 BYI3 BZI3 ;
  6219. XR = VT3 PSCA VT2 ;
  6220. YR = VT3 PSCA VN2 ;
  6221. * MESS 'XR =' XR 'YR =' YR ;
  6222. ALPHA = ATG YR XR ;
  6223. * MESS 'ALPHA =' ALPHA ;
  6224. DS2 = NORM (MOIN P2 P3) ;
  6225. RR = (ALPHA*PI/180.)/DS2 ;
  6226. SI (RR NEG 0.) ;
  6227. R = 1./RR ;
  6228. SINON ;
  6229. R = 1.E99 ;
  6230. FINSI ;
  6231. * MESS 'R =' R ;
  6232. XT = VB2 PSCA VB3 ;
  6233. YT = VB2 PSCA VN3 ;
  6234. * MESS 'XT =' XT 'YT =' YT ;
  6235. BETA = ATG YT XT ;
  6236. * MESS 'BETA =' BETA ;
  6237. TT = -1*(BETA*PI/180.)/DS2 ;
  6238. SI (TT NEG 0.) ;
  6239. T = 1./TT ;
  6240. SINON ;
  6241. T = 1.E99 ;
  6242. FINSI ;
  6243. * MESS 'T =' T ;
  6244.  
  6245. SINON;
  6246. NXI2 = EXTR CHN NX P2 ;
  6247. NYI2 = EXTR CHN NY P2 ;
  6248. VN2 = NXI2 NYI2 ;
  6249. TXI2 = EXTR CHT TX P2 ;
  6250. TYI2 = EXTR CHT TY P2 ;
  6251. VT2 = TXI2 TYI2 ;
  6252. BXI2 = EXTR CHB BX P2 ;
  6253. BYI2 = EXTR CHB BY P2 ;
  6254. VB2 = BXI2 BYI2 ;
  6255. NXI3 = EXTR CHN NX P3 ;
  6256. NYI3 = EXTR CHN NY P3 ;
  6257. VN3 = NXI3 NYI3 ;
  6258. TXI3 = EXTR CHT TX P3 ;
  6259. TYI3 = EXTR CHT TY P3 ;
  6260. VT3 = TXI3 TYI3 ;
  6261. BXI3 = EXTR CHB BX P3 ;
  6262. BYI3 = EXTR CHB BY P3 ;
  6263. VB3 = BXI3 BYI3 ;
  6264. XR = VT3 PSCA VT2 ;
  6265. YR = VT3 PSCA VN2 ;
  6266. * MESS 'XR =' XR 'YR =' YR ;
  6267. ALPHA = ATG YR XR ;
  6268. * MESS 'ALPHA =' ALPHA ;
  6269. DS2 = NORM (MOIN P2 P3) ;
  6270. RR = (ALPHA*PI/180.)/DS2 ;
  6271. SI (RR NEG 0.) ;
  6272. R = 1./RR ;
  6273. SINON ;
  6274. R = 1.E99 ;
  6275. FINSI ;
  6276. * MESS 'R =' R ;
  6277. BETA = 0.;
  6278. T = 0.;
  6279. FINSI;
  6280. FINPROC DS2 R T ALPHA BETA ;
  6281. **** @COUTOR2
  6282. *****************************************************************
  6283. * PROCEDURE @COUTOR2 : CREATION DE 2 CHAMPS PAR ELEMENTS R ET T
  6284. *****************************************************************
  6285. DEBPROC @COUTOR2 GEOFRE*MAILLAGE CHT*CHPOINT CHN*CHPOINT CHB*CHPOINT ;
  6286.  
  6287. NBELGEO = NBEL GEOFRE;
  6288. DIMGEO1 = VALEUR DIME ;
  6289. NBEL1 = 0;
  6290. REPETER BOUCEL NBELGEO;
  6291. NBEL1 = NBEL1 + 1;
  6292. ELEMCOUR = GEOFRE ELEM NBEL1;
  6293. PTINIT = ELEMCOUR POIN INITIAL;
  6294. PTFIN = ELEMCOUR POIN FINAL;
  6295. SI (DIMGEO1 > 2);
  6296. NXI2 = EXTR CHN NX PTINIT ;
  6297. NYI2 = EXTR CHN NY PTINIT ;
  6298. NZI2 = EXTR CHN NZ PTINIT ;
  6299. VN2 = NXI2 NYI2 NZI2 ;
  6300. TXI2 = EXTR CHT TX PTINIT ;
  6301. TYI2 = EXTR CHT TY PTINIT ;
  6302. TZI2 = EXTR CHT TZ PTINIT ;
  6303. VT2 = TXI2 TYI2 TZI2 ;
  6304. BXI2 = EXTR CHB BX PTINIT ;
  6305. BYI2 = EXTR CHB BY PTINIT ;
  6306. BZI2 = EXTR CHB BZ PTINIT ;
  6307. VB2 = BXI2 BYI2 BZI2 ;
  6308. NXI3 = EXTR CHN NX PTFIN ;
  6309. NYI3 = EXTR CHN NY PTFIN ;
  6310. NZI3 = EXTR CHN NZ PTFIN ;
  6311. VN3 = NXI3 NYI3 NZI3 ;
  6312. TXI3 = EXTR CHT TX PTFIN ;
  6313. TYI3 = EXTR CHT TY PTFIN ;
  6314. TZI3 = EXTR CHT TZ PTFIN ;
  6315. VT3 = TXI3 TYI3 TZI3 ;
  6316. BXI3 = EXTR CHB BX PTFIN ;
  6317. BYI3 = EXTR CHB BY PTFIN ;
  6318. BZI3 = EXTR CHB BZ PTFIN ;
  6319. VB3 = BXI3 BYI3 BZI3 ;
  6320. XR = VT3 PSCA VT2 ;
  6321. YR = VT3 PSCA VN2 ;
  6322. * MESS 'XR =' XR 'YR =' YR ;
  6323. ALPHA = ATG YR XR ;
  6324. * MESS 'ALPHA =' ALPHA ;
  6325. DS2 = NORM (MOIN PTINIT PTFIN) ;
  6326. RR = (ALPHA*PI/180.)/DS2 ;
  6327. SI (RR NEG 0.) ;
  6328. R = 1./RR ;
  6329. SINON ;
  6330. R = 1.E99 ;
  6331. FINSI ;
  6332. * MESS 'R =' R ;
  6333. XT = VB2 PSCA VB3 ;
  6334. YT = VB2 PSCA VN3 ;
  6335. * MESS 'XT =' XT 'YT =' YT ;
  6336. BETA = ATG YT XT ;
  6337. * MESS 'BETA =' BETA ;
  6338. TT = -1*(BETA*PI/180.)/DS2 ;
  6339. SI (TT NEG 0.) ;
  6340. T = 1./TT ;
  6341. SINON ;
  6342. T = 1.E99 ;
  6343. FINSI ;
  6344. * MESS 'T =' T ;
  6345.  
  6346. SINON;
  6347. NXI2 = EXTR CHN NX PTINIT ;
  6348. NYI2 = EXTR CHN NY PTINIT ;
  6349. VN2 = NXI2 NYI2 ;
  6350. TXI2 = EXTR CHT TX PTINIT ;
  6351. TYI2 = EXTR CHT TY PTINIT ;
  6352. VT2 = TXI2 TYI2 ;
  6353. BXI2 = EXTR CHB BX PTINIT ;
  6354. BYI2 = EXTR CHB BY PTINIT ;
  6355. VB2 = BXI2 BYI2 ;
  6356. NXI3 = EXTR CHN NX PTFIN ;
  6357. NYI3 = EXTR CHN NY PTFIN ;
  6358. VN3 = NXI3 NYI3 ;
  6359. TXI3 = EXTR CHT TX PTFIN ;
  6360. TYI3 = EXTR CHT TY PTFIN ;
  6361. VT3 = TXI3 TYI3 ;
  6362. BXI3 = EXTR CHB BX PTFIN ;
  6363. BYI3 = EXTR CHB BY PTFIN ;
  6364. VB3 = BXI3 BYI3 ;
  6365. XR = VT3 PSCA VT2 ;
  6366. YR = VT3 PSCA VN2 ;
  6367. * MESS 'XR =' XR 'YR =' YR ;
  6368. ALPHA = ATG YR XR ;
  6369. * MESS 'ALPHA =' ALPHA ;
  6370. DS2 = NORM (MOIN PTINIT PTFIN) ;
  6371. RR = (ALPHA*PI/180.)/DS2 ;
  6372. SI (RR NEG 0.) ;
  6373. R = 1./RR ;
  6374. SINON ;
  6375. R = 1.E99 ;
  6376. FINSI ;
  6377. * MESS 'R =' R ;
  6378. BETA = 0.;
  6379. T = 0.;
  6380. FINSI;
  6381. SI (EGA NBEL1 1) ;
  6382. CHCOU = PROG R ;
  6383. CHTOR = PROG T ;
  6384. SINON ;
  6385. CHCOU =CHCOU ET (PROG R) ;
  6386. CHTOR = CHTOR ET ( PROG T ) ;
  6387. FINSI;
  6388. FIN BOUCEL;
  6389. CHRT = MANU CHML GEOFRE 'R' CHCOU 'T' CHTOR TYPE GRAVITE ;
  6390. FINPROC CHRT;
  6391. **** @CRCACY
  6392. DEBPROC @CRCACY XG*CHPOINT YG*CHPOINT ZG*CHPOINT ;
  6393. *
  6394. ***************************************************************
  6395. * NICOLAS CURT 30032000Procedure de changement de repere.
  6396. * cartesiennes => cylindriques
  6397. *
  6398. ***************************************************************
  6399. *
  6400. PHI = ATG YG XG ;
  6401.  
  6402. RHO = (XG*XG + (YG*YG))**0.5 ;
  6403. *
  6404. FINPROC RHO PHI ZG ;
  6405.  
  6406.  
  6407. **** @CRGMC
  6408. DEBPROC @CRGMC XG*CHPOINT YG*CHPOINT ZG*CHPOINT TAB1*TABLE ;
  6409. *
  6410. *******************************************************************
  6411. * Procedure de changement de repere. On passe du repere cartesien *
  6412. * global de la machine defini par son origine au centre du tore, *
  6413. * l'axe du tore dirige suivant Z et l'axe X situe dans le plan *
  6414. * median entre deux bobines au repere cartesien du maillage. *
  6415. * Trois cas sont etudies : 3D, 2D en coupe Phi constant et 2D en *
  6416. * coupe Theta constant. Alain MOAL (Decembre 1995-Janvier 1996) *
  6417. *******************************************************************
  6418. *
  6419. *--------------- VARIABLES D'ENTREE :
  6420. SI ((VALEUR DIME) EGA 2) ;
  6421. IPLAN = TAB1.<PLAN ;
  6422. SI (EGA IPLAN 'PHICONS') ;
  6423. CT0 = TAB1.<CENTRE_TORE ;
  6424. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  6425. P1 = TAB1.<POINT_SUR_OBJET ;
  6426. FINSI ;
  6427. SI (EGA IPLAN 'THECONS') ;
  6428. THETA0 = TAB1.<THETA0 ;
  6429. CP = TAB1.CENTRE_PLASMA ;
  6430. RP = TAB1.<RP ;
  6431. HP = TAB1.<HP ;
  6432. FINSI ;
  6433. SINON ;
  6434. CT0 = TAB1.<CENTRE_TORE ;
  6435. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  6436. P1 = TAB1.<POINT_SUR_OBJET ;
  6437. FINSI ;
  6438. ANGPHI0 = TAB1.<ANG_PHI0 ;
  6439. *------------------------------------
  6440. *
  6441. DIM0 = VALEUR DIME ;
  6442. SI (DIM0 EGA 2) ;
  6443. FINSI ;
  6444. *
  6445. SI (((DIM0 EGA 2) ET (EGA IPLAN 'PHICONS')) OU (DIM0 EGA 3)) ;
  6446. * ---- en 3D ou en 2D pour la section Phi constant
  6447. X0 Y0 Z0 = COOR CT0 ;
  6448. X1 Y1 Z1 = COOR CT1 ;
  6449. XP1 YP1 ZP1 = COOR P1 ;
  6450. *
  6451. * ---- Calcul des coordonnees du point P0, projection du point P1 de
  6452. * ---- l'objet dans le plan orthogonal a l'axe du tore en CT0.
  6453. A = X1 - X0 ;
  6454. B = Y1 - Y0 ;
  6455. C = Z1 - Z0 ;
  6456. *
  6457. SI (A EGA 0.) ;
  6458. SI (B EGA 0.) ;
  6459. XP0 = XP1 ;
  6460. YP0 = YP1 ;
  6461. ZP0 = Z0 ;
  6462. FINSI ;
  6463. SI (C EGA 0.) ;
  6464. XP0 = XP1 ;
  6465. YP0 = Y0 ;
  6466. ZP0 = ZP1 ;
  6467. FINSI ;
  6468. SI ((B NEG 0.) ET (C NEG 0.)) ;
  6469. XP0 = XP1 ;
  6470. YP0 = (-1.*B*C*ZP1 + (C*C*YP1) + (B*B*Y0) + (B*C*Z0)) /(B*B + (C*C)) ;
  6471. ZP0 = (B*ZP1 - (C*YP1) + (C*(Y0+Z0)))/(B+C);
  6472. FINSI ;
  6473. SINON ;
  6474. AUX1 = A / (A*A + (B*B) + (C*C)) ;
  6475. AUX2 = (B*B + (C*C)) / A ;
  6476. XP0 = AUX1 * (A*X0 + (B*Y0) + (C*Z0) + (AUX2*XP1) - (B*YP1) - (C*ZP1)) ;
  6477. YP0 = B * (XP0 - XP1) / A + YP1 ;
  6478. ZP0 = C * (XP0 - XP1) / A + ZP1 ;
  6479. FINSI ;
  6480. *
  6481. P0 = XP0 YP0 ZP0 ;
  6482. *
  6483. * ---- Rotation de la ligne (CT0,P0) pour l'aligner sur l'axe X
  6484. * ---- du repere global
  6485. LIG0 = CT0 D 1 P0 ;
  6486. LIG1 = LIG0 TOUR (-1.*ANGPHI0) CT0 CT1 ;
  6487. *
  6488. * ---- Calcul des 3 vecteurs unitaires du repere global
  6489. P0X = LIG1 POIN FINAL ;
  6490. DIR1 = P0X MOIN CT0 ;
  6491. VEC1 = DIR1 / (NORM DIR1) ;
  6492. DIR3 = CT1 MOIN CT0 ;
  6493. VEC3 = DIR3 / (NORM DIR3) ;
  6494. VEC2 = VEC3 PVEC VEC1 ;
  6495. *
  6496. * ---- Changement de repere
  6497. A1 B1 C1 = COOR VEC1 ;
  6498. A2 B2 C2 = COOR VEC2 ;
  6499. A3 B3 C3 = COOR VEC3 ;
  6500. *
  6501. XM1 = (A1 * XG) + (A2 * YG) + (A3 * ZG) ;
  6502. YM1 = (B1 * XG) + (B2 * YG) + (B3 * ZG) ;
  6503. ZM1 = (C1 * XG) + (C2 * YG) + (C3 * ZG) ;
  6504. *
  6505. XM = XM1 + X0 ;
  6506. YM = YM1 + Y0 ;
  6507. ZM = ZM1 + Z0 ;
  6508. *
  6509. SINON ;
  6510. *
  6511. * ---- en 2D pour une section a Theta constant
  6512. XCP YCP ZCP = COOR CP ;
  6513. NORM_CP = (XCP*XCP + (YCP*YCP) + (ZCP*ZCP))**0.5 ;
  6514. ANG1 = ATG XCP YCP ;
  6515. *
  6516. * ---- Rotation de (90 + ANGPHI0) par rapport a l'axe Z
  6517. X1 = -1. * XG * (SIN ANGPHI0) + (YG * (COS ANGPHI0)) ;
  6518. Y1 = -1. * XG * (COS ANGPHI0) - (YG * (SIN ANGPHI0)) ;
  6519. Z1 = ZG ;
  6520. *
  6521. * ---- Changement d'origine vers le centre du plasma
  6522. X2 = X1 ;
  6523. Y2 = Y1 + RP + (NORM_CP * (COS THETA0)) ;
  6524. Z2 = Z1 - HP - (NORM_CP * (SIN THETA0)) ;
  6525. *
  6526. * ---- Rotation de -THETA0 par rapport a l'axe X
  6527. X3 = X2 ;
  6528. Y3 = Y2 * (COS THETA0) - (Z2 * (SIN THETA0)) ;
  6529. Z3 = Y2 * (SIN THETA0) + (Z2 * (COS THETA0)) ;
  6530. *
  6531. * ---- Rotation de ANG1 par rapport a l'axe Z
  6532. XM = X3 * (COS ANG1) + (Y3 * (SIN ANG1)) ;
  6533. YM = -1. * X3 * (SIN ANG1) + (Y3 * (COS ANG1)) ;
  6534. ZM = Z3 ;
  6535. *
  6536. FINSI ;
  6537. *
  6538. SI (DIM0 EGA 2) ;
  6539. FINSI ;
  6540. *
  6541. FINPROC XM YM ZM ;
  6542.  
  6543. **** @CRGTC
  6544. DEBPROC @CRGTC XG*CHPOINT YG*CHPOINT ZG*CHPOINT R*FLOTTANT H*FLOTTANT ;
  6545. *
  6546. ***************************************************************
  6547. * Procedure de changement de repere. On passe des coordonnees *
  6548. * cartesiennes dans le repere global de la machine defini par *
  6549. * son origine au centre du tore, l'axe du tore dirige suivant *
  6550. * Z et l'axe X situe dans le plan median entre deux bobines *
  6551. * aux coordonnees pseudo-toroidales dans un repere defini par *
  6552. * son grand rayon R et la hauteur H de son centre par rapport *
  6553. * au plan equatorial. Alain MOAL (decembre 1995) *
  6554. ***************************************************************
  6555. *mess ' ---> calling @CRGTC';
  6556. *
  6557. PHI = ATG YG XG ;
  6558. *
  6559. *
  6560. *---- Rotation de Phi par rapport a l'axe Z
  6561. *
  6562. X1 = (COS PHI) * XG + ((SIN PHI) * YG) ;
  6563. Y1 = -1. * (SIN PHI) * XG + ((COS PHI) * YG) ;
  6564. Z1 = ZG ;
  6565. *
  6566. *---- Changement d'origine vers le centre du nouveau repere
  6567. X2 = X1 - R ;
  6568. Y2 = Y1 ;
  6569. Z2 = Z1 - H ;
  6570. *
  6571. *---- Calcul de Theta et Rho
  6572. *
  6573. THETA = ATG Z2 X2 ;
  6574. RHO = (X2*X2 + (Z2*Z2))**0.5 ;
  6575. *mess ' ---> exiting @CRGTC';
  6576. FINPROC RHO THETA PHI ;
  6577. **** @CRIT
  6578. DEBPROC @CRIT TAB1*TABLE;
  6579.  
  6580. MESS '---------------------------------> calling @CRIT';
  6581. MESS ' Calcul du critere d interception par le code';
  6582. *
  6583. * ========= PARAMETRES D'ENTREE
  6584. MAIL2 = TAB1.<S_OMBRANT;
  6585. ALPHA = TAB1.<INCIDENCE_MAXIMALE ;
  6586. PASB0 = TAB1.<PAS_AVEC_TEST ;
  6587.  
  6588.  
  6589. * CALCUL DES PARAMETRES GEOMETRIQUES ENTRANT DANS *
  6590. * LE CALCUL DE DELIM *
  6591.  
  6592. * ---- CAS 3D
  6593. SI ((VALEUR DIME) EGA 3) ;
  6594. C2MAX = 0. ;
  6595. LMOT = MAIL2 ELEM 'TYPE' ;
  6596. typ = table ;
  6597. ntyp = dime LMOT ;
  6598. bootri = faux ;
  6599. booqua = faux ;
  6600. repeter bouty ntyp ;
  6601. i = &bouty ;
  6602. typ.i = extr LMOT i ;
  6603. si (ega typ.i tri3);bootri = vrai; finsi ;
  6604. si (ega typ.i qua4);booqua = vrai; finsi ;
  6605. fin bouty ;
  6606.  
  6607.  
  6608.  
  6609. * ---- BOUCLE LES MAILLES TRIANGULAIRES *
  6610. si bootri ;
  6611. nbtri = nbel (MAIL2 elem tri3) ;
  6612. repeter boutri nbtri ;
  6613. i = &boutri ;
  6614. eli = MAIL2 elem tri3 i ;
  6615. eli = chan eli poi1 ;
  6616. * ---- CALCUL DES DISTANCES A UN DES SOMMETS DE LA MAILLE *
  6617. nbmai = nbno eli ;
  6618. pt1 = elem eli point 1 ;
  6619. pt2 = elem eli point 2 ;
  6620. pt3 = elem eli point 3 ;
  6621. d1_2 = NORM (MOIN PT1 PT2) ;
  6622. d1_3 = NORM (MOIN PT1 PT3) ;
  6623. d3_2 = NORM (MOIN PT3 PT2) ;
  6624. lid = prog d1_2 d1_3 d3_2 ;
  6625. C2 = MAXI lid ;
  6626. C1 = MINI lid ;
  6627.  
  6628. * --- ON CONSIDERE LA MAILLE LA PLUS GRANDE
  6629. SI (C2 > C2MAX) ;
  6630. C2MAX = C2 ;
  6631. C1CO = C1 ;
  6632. FINSI ;
  6633. fin boutri ;
  6634. finsi ;
  6635.  
  6636.  
  6637.  
  6638. * ---- BOUCLE LES MAILLES QUADRANGULAIRES *
  6639. si booqua ;
  6640. nbqua = nbel (MAIL2 elem qua4) ;
  6641.  
  6642. repeter bouqua nbqua ;
  6643. i = &bouqua ;
  6644. eli = MAIL2 elem qua4 i ;
  6645. eli = chan eli poi1 ;
  6646. * ---- CALCUL DES DISTANCES ENTRE LES SOMMETS DE LA MAILLE *
  6647. nbmai = nbel eli ;
  6648. pt1 = elem eli point 1 ;
  6649. pt2 = elem eli point 2 ;
  6650. pt3 = elem eli point 3 ;
  6651. pt4 = elem eli point 4 ;
  6652. d1_2 = NORM (MOIN PT1 PT2) ;
  6653. d2_3 = NORM (MOIN PT3 PT2) ;
  6654. d3_4 = NORM (MOIN PT3 PT4) ;
  6655. d4_1 = NORM (MOIN PT1 PT4) ;
  6656.  
  6657. * ---- CAS DES RECTANGLES *
  6658. SI ((d1_2 ega d3_4) et (d2_3 ega d4_1)) ;
  6659. lid = prog d1_2 d2_3 ;
  6660. c2 = maxi lid ;
  6661. c1 = mini lid ;
  6662.  
  6663.  
  6664. * ---- CAS D'UNE MAILLE NON STRUCTUREE *
  6665. SINON ;
  6666. lid = ORDONNER (prog d1_2 d2_3 d3_4 d4_1) ;
  6667.  
  6668. C2 = EXTR LID 4 ;
  6669. C1 = EXTR LID 3 ;
  6670.  
  6671. FINSI ;
  6672.  
  6673. * --- ON CONSIDERE LA MAILLE LA PLUS GRANDE
  6674. SI (C2 > C2MAX) ;
  6675. C2MAX = C2 ;
  6676. C1CO = C1 ;
  6677. FINSI ;
  6678.  
  6679. fin bouqua ;
  6680. finsi ;
  6681.  
  6682.  
  6683. * --- CALCUL DU CRITERE SELON LA FORMULE TROUVEE
  6684. delim = (((C2MAX**2)+(PASB0**2)+((C1CO*(SIN ALPHA))**2))**0.5) / 2. ;
  6685.  
  6686.  
  6687.  
  6688. * ---- CAS 2D (On considere le pas non projete => majore delim
  6689. SINON ;
  6690. NSEG2 = NBEL (MAIL2 elem SEG2) ;
  6691. CMAX = 0. ;
  6692. REPETER BOUSEG2 NSEG2 ;
  6693. I = &BOUSEG2 ;
  6694. ELI = MAIL2 ELEM SEG2 I ;
  6695. eli = chan eli poi1 ;
  6696. * ---- CALCUL DE LA DISTANCE ENTRE LES EXTREMITES DE LA MAILLE *
  6697. pt1 = elem eli point 1 ;
  6698. pt2 = elem eli point 2 ;
  6699. D1_2 = NORM (MOIN PT1 PT2) ;
  6700. * ---- On stocke la distance la plus grande
  6701. SI (D1_2 > CMAX) ;
  6702. CMAX = D1_2 ;
  6703. FINSI ;
  6704. FIN BOUSEG2 ;
  6705.  
  6706.  
  6707. * --- CALCUL DU CRITERE SELON LA FORMULE TROUVEE
  6708. DELIM = (((PASB0**2)+((CMAX*(SIN ALPHA))**2))**0.5) / 2. ;
  6709. FINSI ;
  6710.  
  6711. MESS '---------------------------------> exiting @CRIT';
  6712. FINPROC delim ;
  6713. **** @CRLMC
  6714. DEBPROC @CRLMC XL*CHPOINT YL*CHPOINT ZL*CHPOINT TAB1*TABLE ;
  6715. *
  6716. *******************************************************************
  6717. * Version amelioree de l'ancien @CRLMC rebaptise @ACRLM *
  6718. * Procedure de changement de repere. On passe du repere cartesien *
  6719. * local de l'objet modelise au repere cartesien du maillage. Le *
  6720. * point de tangence au plasma est l'origine du repere local et *
  6721. * l'axe Y est dirige vers le centre du plasma. En 3D, L'axe X du *
  6722. * repere local est dans la direction toroidale. *
  6723. * en 2D cas PHICONS l'axe Z du repere local est l'axe toroidal *
  6724. * en 2D cas THECONS l'axe x du repere local est l'axe toroidal *
  6725. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  6726. *******************************************************************
  6727. *
  6728. *--------------- VARIABLES D'ENTREE :
  6729. CP = TAB1.CENTRE_PLASMA ;
  6730. PTG = TAB1.PT_TGPLASMA ;
  6731. SI ((VALEUR DIME) EGA 2) ;
  6732. SI (EXISTE TAB1 <PLAN) ;
  6733. IPLAN = TAB1.<PLAN ;
  6734. SINON ;
  6735. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  6736. FINSI ;
  6737. SINON ;
  6738. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  6739. DIR1 = TAB1.<DIR_TOROIDAL ;
  6740. SINON ;
  6741. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  6742. FINSI ;
  6743. FINSI ;
  6744. *------------------------------------
  6745. *
  6746. SI ((VALEUR DIME) EGA 2) ;
  6747. VECT0 = CP MOINS PTG ;
  6748. VX VY = COOR VECT0 ;
  6749. *
  6750. * ---- calcul de l'angle de rotation dans le plan XY
  6751. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  6752. ANG1 = 0. ;
  6753. SINON ;
  6754. ANG1 = -1.* (ATG VX VY) ;
  6755. FINSI ;
  6756. *
  6757. XPTG YPTG = COOR PTG ;
  6758. *
  6759. SI (EGA IPLAN 'PHICONS');
  6760. * ---- Coupe 2D a Phi constant
  6761. XL = ZL ;
  6762. ZL = ZL * 0.;
  6763. * ---- rotation
  6764. XL1 = XL * (COS ANG1) + (YL * (-1.) * (SIN ANG1));
  6765. YL1 = XL * (SIN ANG1) + (YL * (COS ANG1));
  6766. FINSI;
  6767. SI (EGA IPLAN 'THECONS');
  6768. * ---- Coupe 2D a Theta constant
  6769. * ---- rotation
  6770. XL1 = XL * (COS ANG1) + (YL * (-1.) * (SIN ANG1));
  6771. YL1 = XL * (SIN ANG1) + (YL * (COS ANG1));
  6772. FINSI;
  6773. * ---- changement d'origine du repere
  6774. XM = XL1 + XPTG ;
  6775. YM = YL1 + YPTG ;
  6776. ZM = YL1 * 0. ;
  6777. *
  6778. SINON ;
  6779. *
  6780. VEC1 = DIR1 / (NORM DIR1) ;
  6781. DIR2 = CP MOINS PTG ;
  6782. VEC2 = DIR2 / (NORM DIR2) ;
  6783. VEC3 = VEC1 PVEC VEC2 ;
  6784. *
  6785. X0 Y0 Z0 = COOR PTG ;
  6786. A1 B1 C1 = COOR VEC1 ;
  6787. A2 B2 C2 = COOR VEC2 ;
  6788. A3 B3 C3 = COOR VEC3 ;
  6789. *
  6790. XM1 = (A1 * XL) + (A2 * YL) + (A3 * ZL) ;
  6791. YM1 = (B1 * XL) + (B2 * YL) + (B3 * ZL) ;
  6792. ZM1 = (C1 * XL) + (C2 * YL) + (C3 * ZL) ;
  6793. *
  6794. XM = XM1 + X0 ;
  6795. YM = YM1 + Y0 ;
  6796. ZM = ZM1 + Z0 ;
  6797. *
  6798. FINSI ;
  6799. FINPROC XM YM ZM ;
  6800. **** @CRLTC
  6801. DEBPROC @CRLTC TAB1*TABLE XM*CHPOINT YM*CHPOINT ZM*CHPOINT R*FLOTTANT ;
  6802. *
  6803. ***************************************************************
  6804. * Procedure de changement de repere, on passe des *
  6805. * coordonnees cartesiennes dans le repere de local de l'objet *
  6806. * XM YM ZM repere defini par TAB1.<RHO0, TAB1.<THETA0 et *
  6807. * TAB1.<RP aux coordonnees pseudo-toroidales defini par un *
  6808. * grand rayon donne R . Alain MOAL (mai 1995) *
  6809. ***************************************************************
  6810. *
  6811. *--------------- VARIABLES D'ENTREE :
  6812. RHO0 = TAB1.<RHO0 ;
  6813. THETA0 = TAB1.<THETA0 ;
  6814. RP = TAB1.<RP ;
  6815. *------------------------------------
  6816. *
  6817. CT0 = COS THETA0 ;
  6818. ST0 = SIN THETA0 ;
  6819. MST0 = ST0 * -1. ;
  6820. *
  6821. *---- 1) rotation d'angle THETA0 autour de l'axe X
  6822. X1 = XM ;
  6823. Y1 = (YM * CT0) + (ZM * ST0) ;
  6824. Z1 = (YM * MST0) + (ZM * CT0) ;
  6825. *
  6826. *---- 2) changement d'origine vers le centre du tore,
  6827. *---- rotation de 180 degres autour de l'axe Z2 pour
  6828. *---- retrouver le repere global puis calcul de PHI
  6829. X2 = X1 ;
  6830. Y2 = Y1 - (RHO0 * CT0 + RP) ;
  6831. Z2 = Z1 + (RHO0 * ST0) ;
  6832. *
  6833. X2 = X2 * -1. ;
  6834. Y2 = Y2 * -1. ;
  6835. PHI = ATG (X2 * -1.) Y2 ;
  6836. *
  6837. *---- 3) rotation d'angle PHI autour de l'axe Z2
  6838. CPHI = COS PHI ;
  6839. SPHI = SIN PHI ;
  6840. MSPHI = SPHI * -1. ;
  6841. X3 = (X2 * CPHI) + (Y2 * SPHI) ;
  6842. Y3 = (X2 * MSPHI) + (Y2 * CPHI) ;
  6843. Z3 = Z2 ;
  6844. *
  6845. *---- 4) changement d'origine vers le centre du nouveau repere
  6846. X4 = X3 ;
  6847. Y4 = Y3 - R ;
  6848. Z4 = Z3 ;
  6849. *
  6850. *---- calcul de RHO et THETA
  6851. RHO = ((Y4 * Y4) + (Z4 * Z4))**0.5 ;
  6852. THETA = ATG Z4 Y4 ;
  6853. *
  6854. MESS '>>>> @CRLTC : max and min of the angle PHI' ;
  6855. MESS (MAXI PHI) (MINI PHI) ;
  6856. *
  6857. FINPROC RHO THETA PHI ;
  6858. **** @CRMGC
  6859. DEBPROC @CRMGC XM*CHPOINT YM*CHPOINT ZM*CHPOINT TAB1*TABLE ;
  6860. *
  6861. *******************************************************************
  6862. * Procedure de changement de repere. On passe du repere cartesien *
  6863. * quelconque du maillage au repere cartesien global de la machine *
  6864. * defini par son origine au centre du tore, l'axe du tore dirige *
  6865. * suivant Z et l'axe X situe dans le plan median entre deux *
  6866. * bobines. Trois cas sont etudies : 3D, 2D en coupe Phi constant *
  6867. * et 2D en coupe Theta constant. Alain MOAL (Decembre 1995) *
  6868. *******************************************************************
  6869. *
  6870. *--------------- VARIABLES D'ENTREE :
  6871. SI ((VALEUR DIME) EGA 2) ;
  6872. IPLAN = TAB1.<PLAN ;
  6873. SI (EGA IPLAN 'PHICONS') ;
  6874. CT0 = TAB1.<CENTRE_TORE ;
  6875. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  6876. P1 = TAB1.<POINT_SUR_OBJET ;
  6877. FINSI ;
  6878. SI (EGA IPLAN 'THECONS') ;
  6879. THETA0 = TAB1.<THETA0 ;
  6880. CP = TAB1.CENTRE_PLASMA ;
  6881. RP = TAB1.<RP ;
  6882. HP = TAB1.<HP ;
  6883. FINSI ;
  6884. SINON ;
  6885. CT0 = TAB1.<CENTRE_TORE ;
  6886. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  6887. P1 = TAB1.<POINT_SUR_OBJET ;
  6888. FINSI ;
  6889. ANGPHI0 = TAB1.<ANG_PHI0 ;
  6890. *------------------------------------
  6891. *
  6892. DIM0 = VALEUR DIME ;
  6893. SI (DIM0 EGA 2) ;
  6894. FINSI ;
  6895. *
  6896. SI (((DIM0 EGA 2) ET (EGA IPLAN 'PHICONS')) OU (DIM0 EGA 3)) ;
  6897. * ---- en 3D ou en 2D pour la section Phi constant
  6898. X0 Y0 Z0 = COOR CT0 ;
  6899. X1 Y1 Z1 = COOR CT1 ;
  6900. XP1 YP1 ZP1 = COOR P1 ;
  6901. *
  6902. * ---- Calcul des coordonnees du point P0, projection du point P1 de
  6903. * ---- l'objet dans le plan orthogonal a l'axe du tore en CT0.
  6904. A = X1 - X0 ;
  6905. B = Y1 - Y0 ;
  6906. C = Z1 - Z0 ;
  6907. *
  6908. SI (A EGA 0.) ;
  6909. SI (B EGA 0.);
  6910. XP0 = XP1 ;
  6911. YP0 = YP1 ;
  6912. ZP0 = Z0 ;
  6913. FINSI ;
  6914. SI (C EGA 0.) ;
  6915. XP0 = XP1 ;
  6916. YP0 = Y0 ;
  6917. ZP0 = ZP1 ;
  6918. FINSI ;
  6919. SI ((B NEG 0.) ET (C NEG 0.)) ;
  6920. XP0 = XP1 ;
  6921. YP0 = (-1.*B*C*ZP1 + (C*C*YP1) + (B*B*Y0) + (B*C*Z0)) /(B*B + (C*C)) ;
  6922. ZP0 = (B*ZP1 - (C*YP1) + (C*(Y0+Z0)))/(B+C);
  6923. FINSI ;
  6924. SINON ;
  6925. AUX1 = A / (A*A + (B*B) + (C*C)) ;
  6926. AUX2 = (B*B + (C*C)) / A ;
  6927. XP0 = AUX1 * (A*X0 + (B*Y0) + (C*Z0) + (AUX2*XP1) - (B*YP1) - (C*ZP1)) ;
  6928. YP0 = B * (XP0 - XP1) / A + YP1 ;
  6929. ZP0 = C * (XP0 - XP1) / A + ZP1 ;
  6930. FINSI ;
  6931. *
  6932. P0 = XP0 YP0 ZP0 ;
  6933. *
  6934. * ---- Rotation de la ligne (CT0,P0) pour l'aligner sur l'axe X
  6935. * ---- du repere global
  6936. LIG0 = CT0 D 1 P0 ;
  6937. LIG1 = LIG0 TOUR (-1.*ANGPHI0) CT0 CT1 ;
  6938. *
  6939. * ---- Calcul des 3 vecteurs unitaires du repere global
  6940. P0X = LIG1 POIN FINAL ;
  6941. DIR1 = P0X MOIN CT0 ;
  6942. VEC1 = DIR1 / (NORM DIR1) ;
  6943. DIR3 = CT1 MOIN CT0 ;
  6944. VEC3 = DIR3 / (NORM DIR3) ;
  6945. VEC2 = VEC3 PVEC VEC1 ;
  6946. *
  6947. * ---- Changement de repere
  6948. A1 B1 C1 = COOR VEC1 ;
  6949. A2 B2 C2 = COOR VEC2 ;
  6950. A3 B3 C3 = COOR VEC3 ;
  6951. *
  6952. XG1 = XM - X0 ;
  6953. YG1 = YM - Y0 ;
  6954. ZG1 = ZM - Z0 ;
  6955. *
  6956. XG = (A1 * XG1) + (B1 * YG1) + (C1 * ZG1) ;
  6957. YG = (A2 * XG1) + (B2 * YG1) + (C2 * ZG1) ;
  6958. ZG = (A3 * XG1) + (B3 * YG1) + (C3 * ZG1) ;
  6959. *
  6960. SINON ;
  6961. * ---- en 2D pour une section a Theta constant
  6962. *
  6963. XCP YCP ZCP = COOR CP ;
  6964. NORM_CP = (XCP*XCP + (YCP*YCP) + (ZCP*ZCP))**0.5 ;
  6965. ANG1 = ATG XCP YCP ;
  6966. *
  6967. * ---- Rotation de - ANG1 par rapport a l'axe Z
  6968. X1 = XM * (COS ANG1) - (YM * (SIN ANG1)) ;
  6969. Y1 = XM * (SIN ANG1) + (YM * (COS ANG1)) ;
  6970. Z1 = ZM ;
  6971. *
  6972. * ---- Rotation de THETA0 par rapport a l'axe X
  6973. X2 = X1 ;
  6974. Y2 = Y1 * (COS THETA0) + (Z1 * (SIN THETA0)) ;
  6975. Z2 = -1. * Y1 * (SIN THETA0) + (Z1 * (COS THETA0)) ;
  6976. *
  6977. * ---- Changement d'origine vers le centre du tore
  6978. X3 = X2 ;
  6979. Y3 = Y2 - RP - (NORM_CP * (COS THETA0)) ;
  6980. Z3 = Z2 + HP + (NORM_CP * (SIN THETA0)) ;
  6981. *
  6982. * ---- Rotation de -(90 + ANGPHI0) par rapport a l'axe Z
  6983. XG = -1. * X3 * (SIN ANGPHI0) - (Y3 * (COS ANGPHI0)) ;
  6984. YG = X3 * (COS ANGPHI0) - (Y3 * (SIN ANGPHI0)) ;
  6985. ZG = Z3 ;
  6986. *
  6987. FINSI;
  6988. *
  6989. SI (DIM0 EGA 2) ;
  6990. FINSI ;
  6991. *
  6992. FINPROC XG YG ZG ;
  6993.  
  6994.  
  6995.  
  6996. **** @CRMLC
  6997. DEBPROC @CRMLC XM*CHPOINT YM*CHPOINT ZM*CHPOINT TAB1*TABLE ;
  6998. *
  6999. *******************************************************************
  7000. * Version amelioree de l'ancien @CRMLC rebaptise @ACRML *
  7001. * Procedure de changement de repere. On passe du repere cartesien *
  7002. * du maillage au repere cartesien local de l'objet modelise. Le *
  7003. * point de tangence au plasma est l'origine de ce repere et l'axe *
  7004. * l'axe Y final est dirige vers le centre du plasma. *
  7005. * en 3D l'axe x du repere local est donne par la direction *
  7006. * toroidale *
  7007. * en 2D cas PHICONS l'axe Z initial est l'axe toroidal *
  7008. * en 2D cas THECONS l'axe x initial est l'axe toroidal *
  7009. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  7010. *******************************************************************
  7011. *
  7012. *--------------- VARIABLES D'ENTREE :
  7013. CP = TAB1.CENTRE_PLASMA ;
  7014. PTG = TAB1.PT_TGPLASMA ;
  7015. SI ((VALEUR DIME) EGA 2) ;
  7016. SI (EXISTE TAB1 <PLAN) ;
  7017. IPLAN = TAB1.<PLAN ;
  7018. SINON ;
  7019. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  7020. FINSI ;
  7021. SINON ;
  7022. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  7023. DIR1 = TAB1.<DIR_TOROIDAL ;
  7024. SINON ;
  7025. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  7026. FINSI ;
  7027. FINSI ;
  7028. *------------------------------------
  7029. *
  7030. SI ((VALEUR DIME) EGA 2) ;
  7031. VECT0 = CP MOINS PTG ;
  7032. VX VY = COOR VECT0 ;
  7033. *
  7034. * ---- calcul de l'angle de rotation dans le plan XY
  7035. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  7036. ANG1 = 0. ;
  7037. SINON ;
  7038. ANG1 = -1.* (ATG VX VY) ;
  7039. FINSI ;
  7040. *
  7041. XPTG YPTG = COOR PTG ;
  7042. *
  7043. * ---- changement d'origine du repere
  7044. XM1 = XM - XPTG ;
  7045. YM1 = YM - YPTG ;
  7046. * ---- rotation pour aligner l'axe Y avec VECT0
  7047. SI (EGA IPLAN 'PHICONS');
  7048. * ---- Coupe 2D a Phi constant
  7049. XL = XM1 * (COS ANG1) + (YM1 * (SIN ANG1));
  7050. YL = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1));
  7051. ZL = XM * 0. ;
  7052. *
  7053. ZL = XL ;
  7054. XL = XL * 0.;
  7055. FINSI;
  7056. SI (EGA IPLAN 'THECONS');
  7057. * ---- Coupe 2D a Theta constant
  7058. XL = XM1 * (COS ANG1) + (YM1 * (SIN ANG1));
  7059. YL = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1));
  7060. ZL = XM * 0. ;
  7061. FINSI ;
  7062. *
  7063. SINON ;
  7064. *
  7065. VEC1 = DIR1 / (NORM DIR1) ;
  7066. DIR2 = CP MOINS PTG ;
  7067. VEC2 = DIR2 / (NORM DIR2) ;
  7068. VEC3 = VEC1 PVEC VEC2 ;
  7069. *
  7070. X0 Y0 Z0 = COOR PTG ;
  7071. A1 B1 C1 = COOR VEC1 ;
  7072. A2 B2 C2 = COOR VEC2 ;
  7073. A3 B3 C3 = COOR VEC3 ;
  7074. *
  7075. XM1 = XM - X0 ;
  7076. YM1 = YM - Y0 ;
  7077. ZM1 = ZM - Z0 ;
  7078. *
  7079. XL = (A1 * XM1) + (B1 * YM1) + (C1 * ZM1) ;
  7080. YL = (A2 * XM1) + (B2 * YM1) + (C2 * ZM1) ;
  7081. ZL = (A3 * XM1) + (B3 * YM1) + (C3 * ZM1) ;
  7082. *
  7083. FINSI ;
  7084. FINPROC XL YL ZL ;
  7085.  
  7086.  
  7087. **** @CRTGC
  7088. DEBPROC @CRTGC RHO*CHPOINT THETA*CHPOINT PHI*CHPOINT R*FLOTTANT H*FLOTTANT ;
  7089. *
  7090. *****************************************************************
  7091. * Procedure de changement de repere. On passe des coordonnees *
  7092. * pseudo-toroidales dans un repere defini par son grand rayon R *
  7093. * et la hauteur H de son centre par rapport au plan equatorial *
  7094. * aux coordonnees cartesiennes dans le repere global de la *
  7095. * machine defini par son origine au centre du tore, l'axe du *
  7096. * tore dirige suivant Z et l'axe X situe dans le plan median *
  7097. * entre deux bobines. Alain MOAL (decembre 1995) *
  7098. *****************************************************************
  7099. *
  7100. X2 = RHO * (COS THETA) ;
  7101. Y2 = RHO * 0. ;
  7102. Z2 = RHO * (SIN THETA) ;
  7103. *
  7104. *---- Changement d'origine vers le centre du tore
  7105. X1 = X2 + R ;
  7106. Y1 = Y2 ;
  7107. Z1 = Z2 + H ;
  7108. *
  7109. *---- Rotation de - phi par rapport a l'axe Z
  7110. XG = (COS PHI) * X1 - ((SIN PHI) * Y1) ;
  7111. YG = (SIN PHI) * X1 + ((COS PHI) * Y1) ;
  7112. ZG = Z1 ;
  7113. *
  7114. FINPROC XG YG ZG ;
  7115. **** @CRTLC
  7116. DEBPROC @CRTLC R*FLOTTANT RHO*CHPOINT THETA*CHPOINT PHI*CHPOINT TAB1*TABLE ;
  7117. *
  7118. ***************************************************************
  7119. * Procedure de changement de repere, on passe des coordonnees *
  7120. * pseudo-toroidales centrees sur un grand rayon R aux *
  7121. * coordonnees cartesiennes dans le repere de la structure *
  7122. * modelisee. Alain MOAL (mai 1995) *
  7123. ***************************************************************
  7124. *
  7125. *--------------- VARIABLES D'ENTREE :
  7126. RHO0 = TAB1.<RHO0 ;
  7127. THETA0 = TAB1.<THETA0 ;
  7128. RP = TAB1.<RP ;
  7129. *------------------------------------
  7130. *
  7131. CT0 = COS THETA0 ;
  7132. ST0 = SIN THETA0 ;
  7133. MST0= ST0 * -1. ;
  7134. CPHI = COS PHI ;
  7135. SPHI = SIN PHI ;
  7136. MSPHI = SPHI * -1. ;
  7137. *
  7138. X4 = RHO * 0. ;
  7139. Y4 = RHO * (COS THETA) ;
  7140. Z4 = RHO * (SIN THETA) ;
  7141. *
  7142. *---- 1) changement d'origine vers le centre du tore
  7143. X3 = X4 ;
  7144. Y3 = Y4 + R ;
  7145. Z3 = Z4 ;
  7146. *
  7147. *---- 2) rotation d'angle - PHI autour de l'axe Z3
  7148. * puis rotation de - 180 degres autour de l'axe Z2
  7149. X2 = (X3 * CPHI) + (Y3 * MSPHI) ;
  7150. Y2 = (X3 * SPHI) + (Y3 * CPHI) ;
  7151. Z2 = Z3 ;
  7152. *
  7153. X2 = X2 * -1. ;
  7154. Y2 = Y2 * -1. ;
  7155. *
  7156. *---- 3) changement d'origine vers le centre d'objet
  7157. X1 = X2 ;
  7158. Y1 = Y2 + RP + (RHO0 * CT0) ;
  7159. Z1 = Z2 - (RHO0 * ST0) ;
  7160. *
  7161. *---- 4) rotation d'angle - THETA0 autour de l'axe X1
  7162. XP = X1 ;
  7163. YP = (Y1 * CT0) + (Z1 * MST0) ;
  7164. ZP = (Y1 * ST0) + (Z1 * CT0) ;
  7165. *
  7166. FINPROC XP YP ZP ;
  7167. **** @CRTTC
  7168. DEBPROC @CRTTC R1*FLOTTANT RHO1*CHPOINT THETA1*CHPOINT PHI1*CHPOINT R2*FLOTTANT ;
  7169. *
  7170. ***************************************************************
  7171. * Procedure de changement de repere. On passe d'un repere *
  7172. * pseudo-toroidal defini par son grand rayon R1 a un autre *
  7173. * repere pseudo-toroidal defini par son grand rayon R2. Ces *
  7174. * deux reperes ont la meme orientation toroidale: Phi1 = Phi2 *
  7175. * Alain MOAL (juin 1995) *
  7176. ***************************************************************
  7177. *
  7178. RHO2 = RHO1**2 + ((R1 - R2)**2) ;
  7179. RHO2 = RHO2 + (RHO1*(R1 - R2)*(COS THETA1)*2.) ;
  7180. RHO2 = RHO2**0.5 ;
  7181. *
  7182. AUX1 = RHO1 * (SIN THETA1) ;
  7183. AUX2 = RHO1 * (COS THETA1) - R2 + R1 ;
  7184. THETA2 = ATG AUX1 AUX2 ;
  7185. *
  7186. PHI2 = PHI1 ;
  7187. *
  7188. FINPROC RHO2 THETA2 PHI2 ;
  7189. **** @CSHIFT
  7190. DEBPROC @CSHIFT RHOM*CHPOINT THETAM*CHPOINT PHIM*CHPOINT IMETHOD*ENTIER TAB1*TABLE ;
  7191. *
  7192. ***************************************************************
  7193. * Procedure de calcul des grand et petit rayons du "cercle de *
  7194. * Shafranov" en chaque point M defini dans le repere centre *
  7195. * sur le plasma. On calcule de plus l'angle theta dans le *
  7196. * repere centre sur le cercle calcule. *
  7197. * Deux methodes sont utilisees pour calculer le grand rayon. *
  7198. * Alain MOAL (aout-sept 1995) *
  7199. ***************************************************************
  7200. *
  7201. *--------------- VARIABLES D'ENTREE :
  7202. RP = TAB1.<RP ;
  7203. RHO0 = TAB1.<RHO0 ;
  7204. LAMB = TAB1.<LAMB ;
  7205. *------------------------------------
  7206. *
  7207. SI ((NON (IMETHOD EGA 1)) ET (NON (IMETHOD EGA 2))) ;
  7208. ERRE '>>>> @CSHIFT : YOU MUST CHOOSE THE METHOD 1 OR 2' ;
  7209. FINSI ;
  7210. *
  7211. *---- variables auxiliaires
  7212. A = ((RHOM/RHO0)**-2) + 1. ;
  7213. A = A * (LAMB + 0.5) ;
  7214. A = A + (LOG (RHOM/RHO0)) - 1. ;
  7215. B = LOG (RHOM/RHO0) ;
  7216. B = B - ((((RHOM/RHO0)**-2) - 1.) * (LAMB + 0.5)) ;
  7217. STM = SIN THETAM ;
  7218. CTM = COS THETAM ;
  7219. AUX1 = 1. + LAMB ;
  7220. AUX2 = RHOM * CTM + RP ;
  7221. AUX3 = RHOM * STM ;
  7222. *
  7223. *---- TEST : calcul du decentrement par la methode de Shafranov
  7224. DELT0 = B * (RHOM**2) / (2.*RP) ;
  7225. MESS '*** TEST : DELT0 *** '; LIST DELT0 ;
  7226. *---- FIN TEST
  7227. *
  7228. SI (IMETHOD EGA 1) ;
  7229. * ---- calcul du grand rayon
  7230. *
  7231. * RM 08/04/97 J'enleve STM qui figure a la fois au numerateur et au denominateur
  7232. * dans l'expression definie par les trois lignes suivantes
  7233. * Il provoque une division par 0 quand des points du maillage sont dans le plan * equatorial * GRANDR = RHOM * RP * CTM * (A - B) ;
  7234. * equatorial
  7235. *
  7236. GRANDR = RHOM * RP * CTM * (A - B) ;
  7237. GRANDR = GRANDR + (2.*(RP**2) - (B*(RHOM**2))) ;
  7238. GRANDR = GRANDR / (2.*RP + (RHOM*CTM*(A - B))) ;
  7239. FINSI ;
  7240. *
  7241. SI (IMETHOD EGA 2) ;
  7242. DELTA = ((AUX2**2) * (AUX1**2)) - ((AUX1 + 1.) * ( ((AUX2**2) + (AUX3**2)) * AUX1 - (RP**2) - ((RHO0**2) * AUX1))) ;
  7243. *
  7244. * ---- deux cercles possibles
  7245. GRANDR1 = ((AUX2 * AUX1) + (DELTA**0.5))/(AUX1 + 1.) ;
  7246. GRANDR2 = ((AUX2 * AUX1) - (DELTA**0.5))/(AUX1 + 1.) ;
  7247. *
  7248. * ---- choix du bon cercle
  7249. SI ((COS THETAM) >EG 0.) ;
  7250. GRANDR = GRANDR2 ;
  7251. SINON ;
  7252. GRANDR = GRANDR1 ;
  7253. FINSI ;
  7254. FINSI ;
  7255. *
  7256. *---- calcul du petit rayon
  7257. PETITR = ((RHOM*CTM+RP-GRANDR)**2 + ((RHOM*STM)**2))**0.5 ;
  7258. *
  7259. *--- calcul de theta dans le repere centre sur le cercle calcule
  7260. THETAR = ATG (RHOM * STM) (RHOM * CTM + RP - GRANDR) ;
  7261. *
  7262. *---- test (methode 1)
  7263. *AM*TERME1 = PETITR * LAMB * (COS THETAR) / GRANDR ;
  7264. *AM*TERME2 = (STM**2 * B + ((CTM**2) * A))/(2.*RP) ;
  7265. *AM*TERME2 = TERME2 + (CTM / RHOM) ;
  7266. *AM*TERME2 = TERME2 * (RP - GRANDR);
  7267. *AM*TERME2 = TERME2 + (RHOM * CTM * A / (2.*RP)) ;
  7268. *AM*ERREUR0 = (ABS ((TERME1-TERME2)/TERME2)) ;
  7269. *AM*MESS 'TEST'; LIST TERME1; LIST TERME2; LIST ERREUR0;
  7270. *
  7271. FINPROC GRANDR PETITR THETAR;
  7272.  
  7273. **** @CVECT
  7274. DEBPROC @CVECT XV*CHPOINT YV*CHPOINT ZV*CHPOINT MAIL0*MAILLAGE COUL0*MOT AMPLI0/FLOTTANT;
  7275. *
  7276. **************************************************************
  7277. * Procedure de creation d'un objet de type vecteur a partir *
  7278. * des composantes d'un champ de vecteurs. *
  7279. * Si le facteur d'amplification pour visualiser un champ de *
  7280. * vecteur sur une geometrie n'est pas donne,il est adapte *
  7281. * aux dimensions geometriques du probleme. *
  7282. * Alain MOAL (juillet 1995) *
  7283. **************************************************************
  7284. *
  7285. XM = COOR 1 MAIL0 ;
  7286. YM = COOR 2 MAIL0 ;
  7287. SI ((VALEUR DIME) EGA 2) ;
  7288. ZM = XM * 0. ;
  7289. SINON ;
  7290. ZM = COOR 3 MAIL0 ;
  7291. FINSI ;
  7292. *
  7293. SI (NON (EXISTE AMPLI0)) ;
  7294. * ---- norme du vecteur
  7295. VECNORM = ((XV * XV) + (YV * YV) + (ZV * ZV))**0.5 ;
  7296. * RM 16.01.03
  7297. mess '>> ccect' ;
  7298. @listmm VECNORM ;
  7299. *
  7300. * ---- calcul d'une longueur caracteristique du maillage
  7301. LONGCAR1 = ABS ((MAXI XM) - (MINI XM)) ;
  7302. LONGCAR2 = ABS ((MAXI YM) - (MINI YM)) ;
  7303. LONGCAR3 = ABS ((MAXI ZM) - (MINI ZM)) ;
  7304. *
  7305. SI ((VALEUR DIME) EGA 2) ;
  7306. LONGCAR = MINI (PROG LONGCAR1 LONGCAR2) ;
  7307. SINON ;
  7308. LONGCAR = MINI (PROG LONGCAR1 LONGCAR2 LONGCAR3) ;
  7309. FINSI ;
  7310. *
  7311. AMPLI0 = LONGCAR / (MAXI VECNORM) / 3.;
  7312. *AM* AMPLI0 = LONGCAR / (MAXI VECNORM) ;
  7313. *AM* AMPLI0 = 2. * LONGCAR / (MAXI VECNORM) ;
  7314. FINSI ;
  7315. *
  7316. SI ((VALEUR DIME) EGA 2) ;
  7317. CHV1 = @ET (NOMC UX XV) (NOMC UY YV) ;
  7318.  
  7319.  
  7320. *CAST94* CHV1 = (NOMC UX XV) ET (NOMC UY YV) ;
  7321. VECT1 = VECT CHV1 AMPLI0 UX UY COUL0 ;
  7322. SINON ;
  7323. CHV1 = @ET (@ET (NOMC UX XV) (NOMC UY YV)) (NOMC UZ ZV) ;
  7324. *CAST94* CHV1 = (NOMC UX XV) ET (NOMC UY YV) ET (NOMC UZ ZV) ;
  7325. VECT1 = VECT CHV1 AMPLI0 UX UY UZ COUL0 ;
  7326. FINSI ;
  7327. FINPROC VECT1 ;
  7328.  
  7329. **** ARBRE derniere modif 16/04/91
  7330. DEBPROC ARBRE MAILSEG*MAILLAGE IMEN*ENTIER;
  7331. * determination du maillage des aretes de la surface de separation
  7332. * en seg2 sera a changer si p2 au lieu de p1
  7333. * HDL CHPOINT VIDE SUR DFCAN EN ENTREE
  7334. MAILSEG = MAILSEG COUL BLAN ;
  7335. NPB= MAILSEG NBNO ;
  7336. IP= 0;
  7337. MESS ' ************************** ' ;
  7338. * TEMPS ;
  7339. MESS ' ************************** ' ;
  7340. MESS ' NBRE DE POINTS DE LA SURFACE DE SEPARATION ' NPB;
  7341. MESS ' NBRE D ELEMENTS DE LA SURFACE DE SEPARATION ' (MAILSEG NBEL);
  7342. IPASS= 0;IMA= 0 ;
  7343. REPETER BOUC1 ;
  7344. IPASS= IPASS + 1;IMA= IMA + 1 ;
  7345. ALBERT= MAILSEG ELEM BLAN ;
  7346. ITUR= 0;
  7347. REPETER BOUCON ;
  7348. ITUR= ITUR + 1 ;
  7349. P1= ALBERT POINT ITUR;
  7350. SEGBL= ALBERT ELEM 'APPUYE' LARGEMENT P1 ;NBL= SEGBL NBEL ;
  7351. SEGPT= MAILSEG ELEM 'APPUYE' LARGEMENT P1 ;NBT= SEGPT NBEL ;
  7352. SI (( NBL < NBT) OU ('EGA' IPASS 1)) ; QUITTER BOUCON ;FINSI ;
  7353. FIN BOUCON ;
  7354. SI (IPASS > 1);
  7355. * TRAC OEIL ((SEGBL COUL ROUG)
  7356. * ET (MAILSEG ELEM BLAN) ET (MAILSEG ELEM VERT)) NOEUDS;
  7357. FINSI ;
  7358. IBL= 0 ;
  7359. * on ordonne les segments connectes a P1 sens P1 PN
  7360. REPETER BOUC0 NBL ;
  7361. IBL= IBL + 1 ;
  7362. SSS= SEGBL ELEM IBL ; 1P= SSS POINT INITIAL ;2P= SSS POINT FINAL ;
  7363. SI ( 1P NEG P1 ) ; SSS= (INVE SSS) ; FINSI ;
  7364. SI (IBL EGA 1 ) ; SSI= SSS;SINON ;
  7365. SSI = SSI ET SSS ; FINSI ;
  7366. 2P= SSS POINT FINAL ;
  7367. FIN BOUC0 ;
  7368. SEGBL= SSI ;
  7369.  
  7370. * SI NBL > 1 ON VA ELIMINER LES DOUBLES DE SEGBL
  7371.  
  7372. IA=0 ;
  7373. SI ( NBL EGA 1 );SEG1= (SEGBL ELEM 1 ) COUL VERT ;
  7374. 2P= SEG1 POINT FINAL ;
  7375. MAILSEG= ( DIFF MAILSEG SEG1 ) ET SEG1 ;
  7376. FINSI ;
  7377. SI ( NBL > 1 ) ;
  7378. REPETER BOUC2 (NBL - 1 );
  7379. IA= IA + 1 ;
  7380. SEG1 = ( SEGBL ELEM IA ) COUL VERT ;
  7381. PP1= SEG1 POINT FINAL ;
  7382. I3= IA + 1 ;
  7383. REPETER BOUC3 ;
  7384. SI ( I3 > NBL ) QUITTER BOUC3 ; FINSI ;
  7385. SEG2 = SEGBL ELEM I3 ;
  7386. PP2=SEG2 POINT FINAL;
  7387. SI ( PP1 EGA PP2 ) ;
  7388. MAILSEG= (DIFF MAILSEG SEG2 );
  7389. * MESS ' ELIMINATION DU NO ' I3 ;
  7390. FINSI ;
  7391. I3= I3 + 1;
  7392. FIN BOUC3 ;
  7393. MAILSEG = ( DIFF MAILSEG SEG1 ) ET SEG1;
  7394. FIN BOUC2 ;
  7395. FINSI ;
  7396. N1= (MAILSEG ELEM VERT) NBEL ;N2= MAILSEG NBEL ;
  7397. * TRAC OEIL MAILSEG ;
  7398. SI ( N1 EGA N2 ) ; QUITTER BOUC1 ; FINSI ;
  7399. SI ( EGA IMA IMEN) ; MENAGE ;IMA = 0 ; FINSI ;
  7400. FIN BOUC1 ;
  7401. SAUTER 2 LIGNES ;
  7402. MESS ' NB D ARETES AYANT SERVI A L INTEGRATION ' N2 ;
  7403. MESS ' ************************** ' ;
  7404. *TEMPS ;
  7405. MAILSEG= MAILSEG ELEM VERT ;
  7406. * HDL= IN_MINI (MAILSEG ELEM VERT ) TABHS ORIG B_ANTI ;
  7407. FINPROC MAILSEG;
  7408. **** FL_HS derniere modif 16/04/91
  7409. DEBPROC FL_HS DFCANT*MAILLAGE TABHS*TABLE TYEL*MOT OBJV*MMODEL;
  7410. * chamelem des projections de hs sur les normales des elements
  7411. * au cdg
  7412. HPX=REDU (TABHS.1) DFCANT ;
  7413. HPY=REDU (TABHS.2) DFCANT ;
  7414. HPZ=REDU (TABHS.3) DFCANT ;
  7415. IP= 0;
  7416. OB1= DFCANT AFFECT (MODELE STANDARD ) TYEL ;
  7417. NBP= DFCANT NBNO ;
  7418. FLHS= MANU CHPO DFCANT 1 'Q' ( PROG NBP * 0. );
  7419. * calcul des moyennes sur l element
  7420. HSXM = PRCH HPX OB1 'GRAVITE' ;
  7421. HSYM = PRCH HPY OB1 'GRAVITE' ;
  7422. HSZM = PRCH HPZ OB1 'GRAVITE' ;
  7423. HNMP = MANU CHAM OB1 'GRAVITE' SCAL 0. ;
  7424. BBNEL= DFCANT NBEL ;
  7425. *
  7426. IP= 0 ;
  7427. IMENA= 0 ;
  7428. REPETER BOUCEL BBNEL ;
  7429. IMENA= IMENA + 1 ;
  7430. IP=IP + 1 ; TOTO= DFCANT ELEM IP ; ITOT= CHAN POI1 TOTO ;
  7431. T1= ITOT POINT 1 ;T2= ITOT POINT 2 ; T3= ITOT POINT 3 ;
  7432. * normale a l element
  7433. V1= T2 MOINS T1 ; V2= T3 MOINS T1 ; NNN= V1 PVECT V2 ;
  7434. NNNR= NNN / (NORM NNN) ;
  7435. CVX= COOR 1 NNNR ;CVY= COOR 2 NNNR ; CVZ= COOR 3 NNNR ;
  7436. HSXE= EXTR HSXM SCAL 1 IP 1 ;
  7437. HSYE= EXTR HSYM SCAL 1 IP 1 ;
  7438. HSZE= EXTR HSZM SCAL 1 IP 1 ;
  7439. VPROJ = (HSXE * CVX ) + (HSYE * CVY ) + (HSZE * CVZ) ;
  7440. FLHS1= FLHS + ( FLUX OBJV VPROJ TOTO ) ;
  7441. DETR FLHS ;FLHS = FLHS1 ;DETR TOTO ;DETR ITOT;
  7442. SI ( EGA IMENA 50 ) ; MESS ' menage ';
  7443. MENAGE ; IMENA= 0 ; FINSI ;
  7444. FIN BOUCEL ;
  7445. FINPROC FLHS ;
  7446. **** IN_MINI derniere modif 16/04/91
  7447. 'DEBPROC' IN_MINI FCAN*'MAILLAGE' TABHS*TABLE ORIG*POINT B_ANTI*MAILLAGE ;
  7448. * integration de v par minimisation fonctionnelle
  7449. * en entree maillage frontiere cote phi et hs sur ce maiilage
  7450. * en sortie V(b)= phi(b)-psi(b) chpoint sur fcan
  7451. * avec psi(p1) = phi(p1)
  7452. HX=TABHS.1;HY=TABHS.2;HZ=TABHS.3;
  7453. nbi = nbno ( fcan elem 1 ) ;
  7454. I= 0 ;
  7455. MESS ' SEPARATION ' (FCAN NBNO) 'POINTS' (FCAN NBEL) 'ELEM ';
  7456. REPE BLOCALC (NBEL FCAN);
  7457. I= I + 1 ;
  7458. SEGCOU = FCAN ELEM I;
  7459. P1 = SEGCOU POIN 1;
  7460. P2 = SEGCOU POIN 2;
  7461. HX1 = EXTR HX SCAL P1 ; HX2 = EXTR HX SCAL P2 ;
  7462. HY1 = EXTR HY SCAL P1 ; HY2 = EXTR HY SCAL P2 ;
  7463. HZ1 = EXTR HZ SCAL P1 ; HZ2 = EXTR HZ SCAL P2 ;
  7464. HMOY =(( HX1 + HX2) / 2.) ( ( HY1 + HY2) / 2.) ((HZ1 + HZ2) / 2.);
  7465. * si ( ega nbi 3 ) ;
  7466. * p3= segcou point 3 ;
  7467. * hmx= extr hx scal p3 ;
  7468. * hmy= extr hy scal p3 ;
  7469. * hmz= extr hz scal p3 ;
  7470. * hmil= ( hmx hmy hmz ) * 4. ;
  7471. * hmoy =( hmoy / 3. ) + ( hmil / 6. )
  7472. * finsi ;
  7473. VL= P2 MOINS P1 ;DL= NORM VL ;VL=VL / DL ;
  7474. DV = (VL PSCAL HMOY ) ;DVI= DV * -1.;
  7475. TI= 1. / DL ;IT= -1. * TI ;
  7476. RIGEL= MANU RIGIDITE SEGCOU (MOTS T ) (PROG TI IT TI) ;
  7477. HH= MANU CHPO SEGCOU 1 'Q' (PROG DVI DV );
  7478. SI (EGA I 1);
  7479. RIGT = RIGEL ;
  7480. HTH = HH ;
  7481. SINON ;
  7482. RIGT1= RIGT ET RIGEL;
  7483. HTH1= HTH ET HH ;
  7484. DETR RIGT;RIGT= RIGT1 ; DETR HTH ;HTH= HTH1 ;
  7485. DETR HH; DETR RIGEL ;
  7486. FINSI ;
  7487. FIN BLOCALC ;
  7488. TITI = RELA 'ENSE' T B_ANTI ;
  7489. TUTU= BLOQUE ORIG T;
  7490. HHHH= RESOU (RIGT ET TUTU ET TITI ) HTH ;
  7491. HHHH= (ENLEVER HHHH LX ) NOMC 'SCAL';
  7492. FINPROC HHHH ;
  7493. **** ARBRE_IN derniere modif 16/04/91
  7494. DEBPROC ARBRE_IN DFCAN*MAILLAGE TABHS*TABLE ORIG*POINT ;
  7495. * CALCUL DE L ARBORESCENCE ET INTEGRATION DE HS.DL
  7496. * cette methode amene des differences suivant le chemin choisi
  7497. * il vaut mieux utiliser l autre ( minimisation)
  7498. * DFCAN SURFACE DE SEPARATION
  7499. * HDL CHPOINT VIDE SUR DFCAN EN ENTREE
  7500. NPB= DFCAN NBNO ;
  7501. HDL= MANU CHPO DFCAN 1 SCAL ( PROG NPB * 0.) ;
  7502.  
  7503. DFCAN= DFCAN COUL BLAN ;
  7504. DFCAN1 = DFCAN ELEM QUA4 ;NELSURF1= DFCAN1 NBEL;
  7505. DFCAN2 = DFCAN ELEM TRI3 ; NELSURF2= DFCAN2 NBEL;
  7506. MAILSEG= CONT ( DFCAN1 ELEM 1 );
  7507. I= 1 ;
  7508. REPE BOUCSEG1 ( NELSURF1 - 1 );
  7509. I = I + 1;
  7510. MAILSEG = MAILSEG ET (CONT (DFCAN1 ELEM I));
  7511. FIN BOUCSEG1;
  7512. I= 0 ;
  7513. REPE BOUCSEG2 NELSURF2;
  7514. I = I + 1;
  7515. MAILSEG = MAILSEG ET (CONT (DFCAN2 ELEM I));
  7516. FIN BOUCSEG2;
  7517.  
  7518. NPB= MAILSEG NBNO ;
  7519. IP= 0;
  7520. MESS ' ************************** ' ;
  7521. *TEMPS ;
  7522. MESS ' ************************** ' ;
  7523. MESS ' NBRE DE POINTS DE LA SURFACE DE SEPARATION ' NPB;
  7524. MESS ' NBRE D ELEMENTS DE LA SURFACE DE SEPARATION ' (MAILSEG NBEL);
  7525. IPASS= 0;
  7526. REPETER BOUC1 ;
  7527. IPASS= IPASS + 1;
  7528. ALBERT= MAILSEG ELEM BLAN ;
  7529. ITUR= 0;
  7530. REPETER BOUCON ;
  7531. ITUR= ITUR + 1 ;
  7532. P1= ALBERT POINT ITUR;
  7533. SEGBL= ALBERT ELEM 'APPUYE' LARGEMENT P1 ;NBL= SEGBL NBEL ;
  7534. SEGPT= MAILSEG ELEM 'APPUYE' LARGEMENT P1 ;NBT= SEGPT NBEL ;
  7535. SI (( NBL < NBT) OU ('EGA' IPASS 1)) ; QUITTER BOUCON ;FINSI ;
  7536. FIN BOUCON ;
  7537. DETR ALBERT ; DETR SEGPT ;
  7538. SI (IPASS > 1);
  7539. * TRAC OEIL ((SEGBL COUL ROUG)
  7540. * ET (MAILSEG ELEM BLAN) ET (MAILSEG ELEM VERT)) NOEUDS;
  7541. FINSI ;
  7542. IBL= 0 ;
  7543. * on ordonne les segments connectes a P1 sens P1 PN
  7544. REPETER BOUC0 NBL ;
  7545. IBL= IBL + 1 ;
  7546. SSS= SEGBL ELEM IBL ; 1P= SSS POINT INITIAL ;2P= SSS POINT FINAL ;
  7547. SI ( 1P NEG P1 ) ; SSS= (INVE SSS) ; FINSI ;
  7548. SI (IBL EGA 1 ) ; SSI= SSS;SINON ;
  7549. SSI1 = SSI ET SSS ;DETR SSI ; SSI = SSI1 ;
  7550. FINSI ;
  7551. 2P= SSS POINT FINAL ;DETR SSS ;
  7552. FIN BOUC0 ;
  7553. SEGBL= SSI ;
  7554.  
  7555. * SI NBL > 1 ON VA ELIMINER LES DOUBLES DE SEGBL
  7556.  
  7557. IA=0 ;
  7558. SI ( NBL EGA 1 );SEG1= (SEGBL ELEM 1 ) COUL VERT ;
  7559. 2P= SEG1 POINT FINAL ;
  7560. VV= EXTR HDL SCAL 2P ;
  7561. SI (( EGA VV 0.) ET (2P NEG ORIG));
  7562. HDL=INT_BIOT HDL P1 2P ORIG TABHS ;
  7563. FINSI ;
  7564. MAILSEG= ( DIFF MAILSEG SEG1 ) ET SEG1 ;
  7565. FINSI ;
  7566. SI ( NBL > 1 ) ;
  7567. REPETER BOUC2 (NBL - 1 );
  7568. IA= IA + 1 ;
  7569. SEG1 = ( SEGBL ELEM IA ) COUL VERT ;
  7570. PP1= SEG1 POINT FINAL ;
  7571. VV= EXTR HDL SCAL PP1 ;
  7572. SI ((EGA VV 0.) ET (PP1 NEG ORIG));
  7573. HDL=INT_BIOT HDL P1 PP1 ORIG TABHS ;
  7574. FINSI ;
  7575. I3= IA + 1 ;
  7576. REPETER BOUC3 ;
  7577. SI ( I3 > NBL ) QUITTER BOUC3 ; FINSI ;
  7578. SEG2 = SEGBL ELEM I3 ;
  7579. PP2=SEG2 POINT FINAL;
  7580. SI ( PP1 EGA PP2 ) ;
  7581. MAILSEG1= (DIFF MAILSEG SEG2 );DETR MAILSEG ;MAILSEG= MAILSEG1 ;
  7582. * MESS ' ELIMINATION DU NO ' I3 ;
  7583. FINSI ;
  7584. *tc mise en commentaire du finsi
  7585. * FINSI;
  7586. I3= I3 + 1;
  7587. FIN BOUC3 ;
  7588. MAILSEG1 = ( DIFF MAILSEG SEG1 ) ET SEG1;
  7589. DETR MAILSEG ; MAILSEG= MAILSE1 ;
  7590. FIN BOUC2 ;
  7591. FINSI ;
  7592. N1= (MAILSEG ELEM VERT) NBEL ;N2= MAILSEG NBEL ;
  7593. * TRAC OEIL MAILSEG ;
  7594. SI ( N1 EGA N2 ) ; QUITTER BOUC1 ; FINSI ;
  7595. FIN BOUC1 ;
  7596. DETR SEGBL ;
  7597. SAUTER 2 LIGNES ;
  7598. MESS ' NB D ARETES AYANT SERVI A L INTEGRATION ' N2 ;
  7599. MESS ' ************************** ' ;
  7600. *TEMPS ;
  7601. MESS ' ************************** ' ;
  7602. * sortie hdl chpoint de V
  7603. FINPROC HDL ;
  7604. **** INT_BIOT derniere modif 16/04/91
  7605. DEBPROC INT_BIOT HDL*CHPOINT 1P*POINT 2P*POINT ORIG*POINT TABHS*TABLE ;
  7606. * integration de ht.dl sur le long des aretes sur la surface de
  7607. * separation
  7608. HSX= TABHS.1 ;HSY=TABHS.2;HSZ= TABHS.3 ;
  7609. * HDL EST LE STOCKAGE DU RESULTAT
  7610. * integrale sur le segment
  7611. XHS1= EXTR HSX SCAL 1P;YHS1= EXTR HSY SCAL 1P; ZHS1= EXTR HSZ SCAL 1P;
  7612. XHS2= EXTR HSX SCAL 2P;YHS2= EXTR HSY SCAL 2P; ZHS2= EXTR HSZ SCAL 2P;
  7613. XHM= (XHS1 + XHS2 ) / 2.;
  7614. YHM= (YHS1 + YHS2 ) / 2.;
  7615. ZHM= (ZHS1 + ZHS2 ) / 2.;
  7616. DL= 2P MOINS 1P ;
  7617. INTSEG=(XHM * (COOR 1 DL)) + (YHM * (COOR 2 DL)) +(ZHM * (COOR 3 DL));
  7618. VAL = EXTR HDL SCAL 1P ;
  7619. VINT = VAL + INTSEG ;
  7620. *LIST (1P ET 2P);
  7621. *MESS 'VAL1P INTSEG VINT2P ' VAL INTSEG VINT ;
  7622. * le cas ou 2p est ORIG a ete exclu a l exterieur
  7623. HDL= HDL + ( MANU CHPO 2P 1 SCAL VINT ) ;
  7624. FINPROC HDL;
  7625. **** SAUT_POT derniere modif 16/04/91
  7626. DEBPROC SAUT_POT FCAN*MAILLAGE FFER*MAILLAGE LLLL*CHPOINT ORIG*POINT ;
  7627. * calcul du saut de potentiel
  7628. ***************************************************************
  7629. * relations entre points homologues de la separation
  7630. * orig est le point ou psi=phi=0.
  7631. * attention a la coherence avec la condition limite
  7632. ***************************************************************
  7633. NNN= FCAN NBNO;
  7634. IK= 0 ;ILO= 0 ;
  7635. REPETER BLOC1 NNN;
  7636. IK= IK + 1 ;
  7637. IP=FCAN POINT IK ;IQ= FFER POINT PROCHE IP ;
  7638. SI (NEG IP ORIG) ;
  7639. RELP= RELA 1. T IP - 1. T IQ ;
  7640. DEPIP= DEPIMP RELP (EXTR LLLL SCAL IP);
  7641. SI (EGA ILO 0 ) ;
  7642. REL1=RELP; FDEPI= DEPIP ;
  7643. ILO= 1 ;
  7644. SINON ;
  7645. REL2= REL1 ET RELP ;
  7646. FDEPI2= FDEPI ET DEPIP ;
  7647. DETR REL1 ; REL1= REL2 ; DETR FDEPI ; FDEPI= FDEPI2 ;
  7648. DETR RELP ;DETR DEPIP ;
  7649. FINSI;
  7650. FINSI;
  7651. FIN BLOC1 ;
  7652. FINPROC REL1 FDEPI;
  7653. **** B_ARETES derniere modif 16/04/91
  7654. DEBPROC B_ARETES SEP_PHI*MAILLAGE ;
  7655. * reduit un maillage surfacique p1 a ses aretes
  7656. * en conservant les doubles
  7657. NBU= SEP_PHI NBEL ;
  7658. DFCAN1 = SEP_PHI ELEM QUA4 ;NBQU= DFCAN1 NBEL ;
  7659. MAILSEG= CONT ( DFCAN1 ELEM 1 );
  7660.  
  7661. SI (NEG NBU NBQU);
  7662. DFCAN2 = SEP_PHI ELEM TRI3 ; NTRI= DFCAN2 NBEL;
  7663. I= 0 ;
  7664. REPE BOUCSEGT NTRI;
  7665. I = I + 1;
  7666. MAILSEG = MAILSEG ET (CONT (DFCAN2 ELEM I));
  7667. FIN BOUCSEGT;
  7668. FINSI ;
  7669. I= 1 ;
  7670. REPE BOUCSEGQ (NBQU - 1 );
  7671. I = I + 1;
  7672. MAILSEG = MAILSEG ET (CONT (DFCAN1 ELEM I));
  7673. FIN BOUCSEGQ;
  7674. TITRE 'MAILSEG ' (MAILSEG NBEL );
  7675. * TRAC OEIL MAILSEG QUAL ;
  7676. FINPROC MAILSEG ;
  7677.  
  7678. *
  7679. **** LIRBIOT derniere modif 16/04/91
  7680. DEBPROC LIRBIOT SEP_PHI*MAILLAGE MU0*FLOTTANT ;
  7681. ***************************************************************
  7682. * RECUP BIOT ET SAVART SUR FRONTIERE
  7683. * genere en exterieur la surface frontiere a ete sortie pas sort
  7684. * noopt precedement et a servi a calculer hs
  7685. * on recupere le tout coordonnees et hs et on elmine pour etre sur
  7686. * du support (ordre )
  7687. ***************************************************************
  7688. NFN=SEP_PHI NBNO ;
  7689. IMET= 2 ;
  7690. SI ( EGA IMET 1);
  7691. OPTION ACQUERIR 9 ;
  7692.  
  7693. ACQUERIR HX*LISTREEL NFN HY*LISTREEL NFN HZ*LISTREEL NFN ;
  7694. HS= MANU CHPO SEP_PHI 3 'HX' HX 'HY' HY 'HZ' HZ ;
  7695. SINON ;
  7696.  
  7697. * AUTRE FACON A ESSAYER
  7698. *
  7699. PPRO= PROG NFN * 0 ;
  7700. HS= MANU CHPO SEP_PHI 3 'HX' PPRO 'HY' PPRO 'HZ' PPRO ;
  7701. OPTION ACQUERIR 8 ;
  7702. IP= 0;
  7703. REPETER BOUCA NFN ;
  7704. ACQUERIR X*FLOTTANT Y*FLOTTANT Z*FLOTTANT HX*FLOTTANT HY*FLOTTANT HZ*FLOTTANT ;
  7705. * X= EXTR VALP 1 ;Y= EXTR VALP 2 ; Z= EXTR VALP 3;
  7706. * HX= EXTR VALP 4 ;HY= EXTR VALP 5 ; HZ= EXTR VALP 6;
  7707. P1= X Y Z ; PT= SEP_PHI POINT PROCHE P1 ;
  7708. HP= MANU CHPO PT 3 'HX' HX 'HY' HY 'HZ' HZ ;
  7709. HS2 = HS + HP ; DETR HS ; HS= HS2 ;
  7710. *tc mise en commentauire du finsi ci dessou
  7711. * FINSI ;
  7712. *
  7713. FIN BOUCA;
  7714. FINSI;
  7715. * provisoire chambob donne B on divise par mu0
  7716. HS= HS / MU0 ;
  7717. * ELIM .1 SEP_PHI PT ;
  7718. FINPROC HS ;
  7719. **** FOR_CONT derniere modif 16/04/91
  7720. DEBPROC FOR_CONT CCONT*MAILLAGE SOL1*CHPOINT COURI*FLOTTANT;
  7721. * calcul des forces par integrale de contour
  7722. OBSEG = CCONT AFFECT ( MODELE STANDARD ) SEG2 ;
  7723. AA = PRCH OBSEG SOL1 'GRAVITE';
  7724. NBSEG = CCONT NBEL ;
  7725. IEL = 0 ;SOMX = 0. ; SOMY = 0. ;SMM = 0. ;
  7726. *
  7727. REPETER BOUC NBSEG ;
  7728. IEL = IEL + 1 ; SEGC= CCONT ELEM IEL ;
  7729. I1 = SEGC POINT INITIAL ; I2 = SEGC POINT FINAL ;
  7730. X1 = COOR 1 I1 ; X2 = COOR 1 I2 ; RX = ( X1 + X2) / 2. ;
  7731. Y1 = COOR 2 I1 ; Y2 = COOR 2 I2 ; RY = ( Y1 + Y2) / 2. ;
  7732. DX = X2 - X1 ; DY = Y2 - Y1 ;
  7733. AME = EXTR AA 'SCAL' 1 IEL 1 ;
  7734. SOMX = SOMX + ( AME * DX) ;
  7735. SOMY = SOMY + ( AME * DY) ;
  7736. MOMM = (RX * DX) + (RY * DY ) ;
  7737. SMM= SMM + ( AME * MOMM ) ;
  7738. FIN BOUC ;
  7739. *
  7740. FXX = COURI * SOMY ; FYY = -1. * COURI * SOMX ;
  7741. MOMT = -1. * COURI * SMM ;
  7742. CDG1 = BARY CCONT ;
  7743. RFORC = MANU CHPO CDG1 2 'FX' FXX 'FY' FYY ;
  7744. FINPROC RFORC SMM ;
  7745. **** FORBLOC derniere modif 16/04/91
  7746. DEBPROC FORBLOC BLOC*MAILLAGE BX*CHAMELEM BY*CHAMELEM OBJO*MMODEL COUR*FLOTTANT ;
  7747. * bobi maillage non complexe
  7748. * bb champ induction AUX CDG du maillage reduit
  7749. * integration de j vectoriel b sur les elements resultats aux cdg
  7750. * sort un champ par points aux cdgs dans rfor
  7751. * sort un champ par point aux noeuds dans rpt
  7752. NNN= BLOC NBEL ;
  7753. IP= 0 ;IPAS= 0 ;
  7754. REPETER BOUE NNN ;
  7755. IPAS= IPAS + 1 ;
  7756. IP = IP + 1 ; IEL =BLOC ELEM IP ;CDG= BARY IEL ;
  7757. EL_SUR= MAXI (RESU (SOURCE OBJ0 COUR IEL ));
  7758. FEX= (EXTR BY 'SCAL' 1 IP 1 ) * EL_SUR;FEX= FEX * -1. ;
  7759. FEY= (EXTR BX 'SCAL' 1 IP 1 ) * EL_SUR;
  7760. R_F= MANU CHPO CDG 2 'FX' FEX 'FY' FEY ;
  7761. NNI = IEL NBNO ;
  7762. RFXP= MANU CHPO IEL 1 'FX' ( PROG NNI * ( FEX / NNI )) ;
  7763. RFYP= MANU CHPO IEL 1 'FY' ( PROG NNI * ( FEY / NNI )) ;
  7764. SI ( EGA IP 1) ;RFOR = R_F ;RPX = RFXP ;RPY=RFYP ;
  7765. SINON ;
  7766. RFOR = RFOR + R_F ;RPX= RPX + RFXP ; RPY= RPY + RFYP ;
  7767. FINSI ;
  7768. * SI ( EGA IPAS 10 ) ;MESS 'menage';MENAGE ; IPAS = 0 ; FINSI ;
  7769. RPT= RPX + RPY ;
  7770. FIN BOUE ;
  7771. *
  7772. FINPROC RFOR RPT ;
  7773. **** INDUCTIO derniere modif fevrier/92
  7774. ******************************************************************
  7775. DEBPROC INDUCTIO GEO*MAILLAGE SOL1*CHPOINT AXI*LOGIQUE ;
  7776. ****************************************************************
  7777. * 2D UNIQUEMENT
  7778. * calcul; de l induction en potentiel vecteur *
  7779. * GEO maillage sur lequel on recherche B *
  7780. * SOL1 solution en potentiel vecteur *
  7781. * AXI logique vrai si axi *
  7782. ****************************************************************
  7783. OBJ0 = GEO MODE THERMIQUE ISOTROPE ;
  7784. GRA_ELR = GRAD OBJ0 SOL1 ;
  7785. DERIV = CHAN CHPO GRA_ELR OBJ0 ;
  7786. SI ( AXI ) ;
  7787. IMET = 2 ;
  7788. SI ( EGA IMET 1 ) ;
  7789. mess '* methode 1';
  7790. 1SRAY = MUAXI2 GEO 1. 1 ;
  7791. FINSI ;
  7792. SI ( EGA IMET 2 ) ;
  7793. 1SRAY = MUAXI2 GEO 1. 2 ;
  7794. FINSI ;
  7795. mess '* axisymetrique methode 'imet ;
  7796. BX = ((EXCO DERIV 'T,Y') * 1SRAY * -1. ) NOMC 'BX' ;
  7797. BY = ((EXCO DERIV 'T,X' ) * 1SRAY ) NOMC 'BY' ;
  7798. SINON ;
  7799. mess '* probleme plan ';
  7800. BX = (EXCO DERIV 'T,Y') NOMC 'BX' ;
  7801. BY = (( EXCO DERIV 'T,X' )* -1.) NOMC 'BY' ;
  7802. FINSI ;
  7803. BTOT = BX + BY ;
  7804. FINPROC BTOT ;
  7805. **** POT_VECT derniere modif 1/03/92
  7806. DEBPROC POT_VECT MATAB*TABLE SOLIN/MOT ;
  7807. ********************************************************************
  7808. * MAGETOSTATIQUE 2D EN POTENTIEL VECTEUR *
  7809. ********************************************************************
  7810. * MATAB TABLE D ENTREE CONTENANT
  7811. * MATAB.'MU0' PERMEABILITE DE L AIR (PAR DEFAUT UNITE METRE *
  7812. * MATAB.'MUREL' MU RELATIF DEPART 2900 PAR DEFAUT *
  7813. * MATAB.'AIR' PARTIE AIR NON REDUITE A UN SUPER ELEMENT *
  7814. * MATAB.'FER' FER *
  7815. * MATAB.'MAITRES' POINT MAITRES SI SUPER ELEMENT *
  7816. * MATAB.'AIRSUP' PARTIE AIR TRAITEE EN SUPER (NON OBLIGATOIRE)*
  7817. * MATAB.'ENCS ' LIMITE A A NULL SUR LE SUPER ELEMENT (MAILL) *
  7818. * MATAB.'BLOCAGE' LIMITE A A NULL SUR LA ZONE STANDARD( MAILL) *
  7819. * MATAB.'COUR' TABLE DE TABLES CONTENANT LA DESCRIPTION DES *
  7820. * BLOCS DE COURANTS CONSTITUEE PAR UN OU DES *
  7821. * APPEL(S) A LA PROCEDURE DESCOUR *
  7822. * MATAB.'AXI' = VRAI SI PROBLEME AXISYMETRIQUE *
  7823. * SOLIN MOT OPTIONNNEL POUR LE CALCUL DU PREMIER PAS LINEAIRE*
  7824. ********************************************************************
  7825. * EN SORTIE MATAB CONTIENT LES OBJETS NECESSAIRES *
  7826. * AU CALCUL NON LINEAIRE *
  7827. * ET LA SOLUION DU PREMIER PAS SI DEMANDEE DS MATAB.'POTENTIEL *
  7828. ********************************************************************
  7829. AXI= FAUX ;
  7830. SI ( EXISTE MATAB 'AXI' ); AXI = MATAB.'AXI' ; FINSI ;
  7831. MUAIR = 4 * PI * 1.E-7 ;
  7832. SI ( EXISTE MATAB 'MU0') ;MUAIR = MATAB.'MU0' ;FINSI ;
  7833. SI ( EXISTE MATAB 'MUREL' ) ;
  7834. MUFER = MUAIR * (MATAB.'MUREL') ;
  7835. SINON ; MUFER = MUAIR * 2900 ;
  7836. FINSI ;
  7837. MATAB.'MUAIR'= MUAIR ;
  7838. AIR = MATAB.'AIR' ;
  7839. FER = MATAB.'FER' ;
  7840. OBJ1=MODE AIR THERMIQUE ISOTROPE ;
  7841. OBJ2=MODE FER THERMIQUE ISOTROPE ;
  7842. SI ( AXI ) ;
  7843. MAT1= MUAXI2 AIR MUAIR 1;
  7844. MAT2= MUAXI2 FER MUFER 1;
  7845. SINON ;
  7846. * rectification conductibilites
  7847. MAT1= MATE OBJ1 'K' ( 1. / MUAIR ) ;
  7848. MAT2= MATE OBJ2 'K' ( 1. / MUFER ) ;
  7849. FINSI ;
  7850. SI ( EXISTE MATAB 'AIRSUP') ;
  7851. AIRSUP = MATAB.'AIRSUP' ;
  7852. OBJ3=MODE AIRSUP THERMIQUE ISOTROPE ;
  7853. SI ( AXI ) ;
  7854. MAT3 = MUAXI2 AIRSUP MUAIR 1 ;
  7855. SINON;
  7856. MAT3= MATE OBJ3 'K' ( 1. / MUAIR ) ;
  7857. FINSI ;
  7858. SI ( EXISTE MATAB 'ENCS' );
  7859. RIGB= (CONDUC OBJ3 MAT3 ) ET ( BLOQUER (MATAB.'ENCS' ) T ) ;
  7860. SFAC = MATAB.'MAITRES';
  7861. SUP1 = SUPER 'RIGIDITE' RIGB SFAC ;
  7862. MATAB.'SUPER' = SUP1 ;
  7863. FINSI ;
  7864. FINSI ;
  7865. RIGA= CONDUC OBJ1 MAT1 ;
  7866. RIGF= CONDUC OBJ2 MAT2 ;
  7867. *
  7868. SI ( EXISTE MATAB 'MAITRES') ;
  7869. RIGCON= RIGA ET ( EXTRAI SUP1 'RIGI' );
  7870. SINON ;
  7871. RIGCON = RIGA ;
  7872. FINSI ;
  7873. * charge
  7874. TABCOUR = TABLE ;
  7875. TABCOUR = MATAB.'COUR';
  7876. III = INDEX TABCOUR ;
  7877. IZ= 'ENTIER' 0 ;
  7878.  
  7879. REPETER BOUC ;
  7880. IZ= IZ + 1 ;
  7881. SI ( 'NON' ('EXISTE' III IZ )) ;QUITTER BOUC ; FINSI ;
  7882. STN = TABCOUR.IZ ;GEO = STN.'GEO' ;
  7883. FEIZ = SOURCE OBJ1 1. GEO ;
  7884. SSS = EXTR (RESU FEIZ) 'Q' (( EXTR FEIZ MAIL ) POINT 1);
  7885. *
  7886. SI ( EXISTE STN 'AMP' ) ;
  7887. J = STN.'AMP' ;
  7888. STN.'AT' = SSS * J ;
  7889. SINON ;
  7890. SDO = STN.'AT' ;
  7891. J = SDO / SSS ;
  7892. STN.'AMP'= J ;
  7893. FINSI ;
  7894. *
  7895. FEIZ = FEIZ * J ;
  7896. *
  7897. MESS ' BLOC ' IZ ' JAMP ' J ' NI' STN.'AT' ;
  7898. SI ( EGA IZ 1 ) ; FE = FEIZ ; SINON ;
  7899. FE = FE + FEIZ ;
  7900. FINSI ;
  7901. FIN BOUC ;
  7902.  
  7903. MATAB.'RHS'= FE ;
  7904.  
  7905. MATAB.'RIGCON'= RIGCON;
  7906. MATAB.'RIGFER'= RIGF;
  7907. SI ( EXISTE SOLIN ) ;
  7908. MESS ' *****************************************************';
  7909. MESS ' * CALCUL DE LA SOLUTION LINEAIRE *';
  7910. MESS ' *****************************************************';
  7911. SI ( EXISTE MATAB 'BLOCAGE' );
  7912. BBB = BLOQUER ( MATAB.'BLOCAGE') T ;
  7913. MATAB.'BLOCAGE'= BBB ;
  7914. SOL1= RESOU ( RIGF ET RIGCON ET BBB ) (MATAB.'RHS') ;
  7915. SINON ;
  7916. SOL1= RESOU ( RIGF ET RIGCON ) (MATAB.'RHS') ;
  7917. FINSI ;
  7918. MATAB.'POTENTIEL'= SOL1 ;
  7919. FINSI ;
  7920. *
  7921. FINPROC ;
  7922. **** DESCOUR derniere modif 16/04/91
  7923. DEBPROC DESCOUR TAB*TABLE I*ENTIER BLOCI*MAILLAGE MM*MOT J*FLOTTANT ;
  7924. *******************************************************************
  7925. * DESCRIPTION D UNE ZONE DE COURANTS *
  7926. * TAB TABLE QUI CONTIENDRA LE DESCIPTIF DE TOUTES LES *
  7927. * ZONES DE COURANTS *
  7928. * I NUMERO D ORDRE DE LA ZONE DE COURANT *
  7929. * BLOCI ZONE DE COURANT TYPE MAILLAGE *
  7930. * MM MOT 'AMP' OU 'AT' *
  7931. * J FLOTTANT DENSITE DE COURANT OU AMPERES TOURS *
  7932. *******************************************************************
  7933. STN= TABLE ;
  7934. STN.'GEO'= BLOCI ;
  7935. SI ( EGA MM 'AMP') ;
  7936. STN.'AMP' = J ;
  7937. SINON ;
  7938. STN.'AT' = J ;
  7939. FINSI ;
  7940. TAB.I= STN ;
  7941. FINPROC ;
  7942. **** MAG_NLIN derniere modif 16/04/91
  7943. 'DEBPROC' MAG_NLIN ETAB*'TABLE ' ;
  7944. *----------------------------------------------------------------------*
  7945. * *
  7946. * INSPIRE DE TRANSIT1 *
  7947. * POUR TENIR COMPTE DE PLUSIEURS MATERIAUX DONT UN NON LINEAIRE *
  7948. * POUR TRAITER PB MAGNETOSTATIQUE *
  7949. * --------------- *
  7950. * *
  7951. * RESOLUTION D'UN PROBLEME DE MAGNETOSTATIQUE NON-LINEAIRE *
  7952. * EN REGIME PERMANENT,A L'AIDE DE LA METHODE DU POINT FIXE *
  7953. * ETAB, TABLE CONTENANT EN ENTREE : *
  7954. * OBLIGATOIRE *
  7955. * INDICE 'SOUSTYPE' THERMIQUE *
  7956. * INDICE 'AXI ' LOGIQUE VRAI EN 2D SI AXISYM ( PLAN DEFAUT) *
  7957. * *
  7958. * INDICE 'EVOCOND' EVOLUTION DE Mu CREE PAR LA PROCEDURE H_B *
  7959. * QUI REND LA COURBE AD HOC POUR POT VECT OU POT SCALAIRE *
  7960. * OPTIONNEL *
  7961. * INDICE 'CRITERE' CRITERE DE CONVERGENCE *
  7962. * INDICE 'OME' COEFF AMORTISSEMENT OSCI 0< OME < 1. *
  7963. * (10E-5 PAR DEFAUT) *
  7964. * INDICE 'NITER' REACTUALISATION DE LA CONDUCTIVITE TOUTES *
  7965. * LES NITER ITERATIONS (NITER=1 PAR DEFAUT) *
  7966. * INDICE 'NIVEAU' NIVEAU DE MESSAGES (NIVEAU=0 PAR DEFAUT) *
  7967. * INDICE 'ITERMAX' NOMBRE D'ITERATIONS MAXIMUM *
  7968. * (ITERMAX=10 PAR DEFAUT) *
  7969. ************************************************************************
  7970. * arguments fabriques dans les passages soit ds pot_vect ou pot_scal *
  7971. * INDICE 'FLUX' FLUX EQUIVALENTS *
  7972. * INDICE 'BLOCAGE' MATRICE DE BLOCAGE (CREEE PAR "BLOQUE") *
  7973. * INDICE 'IMPOSE' VALEURS IMPOSEES (CREE PAR "DEPI") *
  7974. * INDICE 'RIGCON ' RAIDEUR CONSTANTE *
  7975. * INDICE 'RIGFER ' RAIDEUR VARIABLE *
  7976. * ETAB CONTENANT EN SORTIE : *
  7977. * *
  7978. * INDICE 'POTENTIEL' POTENTIEL RESULTAT *
  7979. * *
  7980. * D.R., LE 7 JUILLET 1988.VERSION DU 18 JANVIER 1989. *
  7981. * MODIFIE PAR BAZE MAI 90
  7982. *----------------------------------------------------------------------*
  7983. CONVERGE = FAUX ;ETAB.CONVERGE= FAUX ;
  7984. 'REPETER' PROC 1 ;
  7985. 'SI' ( 'NEG' ( ETAB.'SOUSTYPE' ) 'THERMIQUE' ) ;
  7986. 'MESS' 'SOUS TYPAGE INCORRECT DE LA TABLE EN ENTREE|' ;
  7987. 'QUITTER' PROC ;
  7988. 'FINSI' ;
  7989. 'SI' ( 'EXISTE' ETAB 'NIVEAU' ) ;
  7990. NIV_MESS = ETAB.'NIVEAU' ;
  7991. 'SINON' ;
  7992. NIV_MESS = 0 ;
  7993. 'FINSI' ;
  7994. 'SI' ( NIV_MESS '>EG' 1 ) ;
  7995. 'SAUTER' 1 'LIGNE' ;
  7996. 'MESS' '*** DEBUT DE LA PROCEDURE "MAG_NONLIN" ***' ;
  7997. 'FINSI' ;
  7998. *
  7999. *--- RECUPERATION DE L'INFORMATION CONTENUE DANS "ETAB"
  8000. *
  8001. 'SI' ('EXISTE' ETAB BLOCAGE );
  8002. MAT_BLO = ETAB.'BLOCAGE' ;
  8003. 'FINSI';
  8004. RIG_CON = ETAB.'RIGCON';
  8005. 'SI' ( 'EXISTE' ETAB 'IMPOSE' );
  8006. VAL_IMPO = ETAB.'IMPOSE' ;
  8007. 'FINSI' ;
  8008. * IL FAUT EXTRAIRE LE FER ;
  8009. FER = EXTRA ( ETAB.RIGFER ) MAIL;
  8010. AXI = FAUX ;
  8011. SI ( EXISTE ETAB 'AXI') ; AXI = ETAB.'AXI' ;FINSI ;
  8012. SI AXI ;
  8013. obmod = MODE FER THERMIQUE ISOTROPE ;
  8014. cp_rpoa = (coor 1 FER ) ;
  8015. ce_rpoa = CHAN 'CHAM' CP_RPOA OBMOD 'GRAVITE';
  8016. RFER = CHAN CHPO OBMOD (CHAN 'NOEUD' OBMOD ce_rpoa );
  8017. FINSI ;
  8018. * SI ( EXISTE ETAB 'SUPER' ) ;
  8019. MAIL_CHP= FER ET ( EXTRA RIG_CON MAIL );
  8020. * SINON ;
  8021. * MAIL_CHP= ETAB.'GEORED' ;
  8022. * FINSI ;
  8023. NBRE_NOE = 'NBNO' MAIL_CHP ;
  8024. VEC1= MANU CHPO MAIL_CHP 1 'T' (PROG NBRE_NOE * 1. ) ;
  8025. QTE_FLUX = ETAB.'RHS' ;
  8026. EVO_COND = ETAB.'EVOCOND' ;
  8027. LIS_COND = 'EXTRAIRE' EVO_COND 'CONDUCTIVITE' ;
  8028. LIS_TEMP = 'EXTRAIRE' EVO_COND 'TEMPERATURE' ;
  8029. VAL_COND=EXTR LIS_COND 1 ;
  8030. * SAUTER 3 LIGNES ;
  8031. * MESS ' CONDUCTIVITE INITIALE DU FER ' VAL_COND ;
  8032. SAUTER 3 LIGNES ;
  8033. 'SI' ( 'EXISTE' ETAB 'CRITERE' ) ;
  8034. EPSILON = ETAB.'CRITERE' ;
  8035. 'SINON' ;
  8036. EPSILON = 1.E-5 ;
  8037. 'FINSI' ;
  8038. 'SI' ( 'EXISTE' ETAB 'NITER' ) ;
  8039. NBRE_ITE = ETAB.'NITER' ;
  8040. 'SI' ( NIV_MESS '>EG' 1 ) ;
  8041. 'SAUTER' 1 'LIGNE' ;
  8042. 'MESS' 'REACTUALISATION DE LA MATRICE DE CONDUCTIVITE A L ENTREE ' 'PUIS TOUTES LES ' NBRE_ITE 'ITERATIONS' ;
  8043. 'FINSI' ;
  8044. 'SINON' ;
  8045. NBRE_ITE = 1 ;
  8046. 'FINSI' ;
  8047. 'SI' ( 'EXISTE' ETAB 'ITERMAX' ) ;
  8048. ITER_MAX = ETAB.'ITERMAX' ;
  8049. 'SINON' ;
  8050. ITER_MAX = 10 ;
  8051. 'FINSI' ;
  8052. **************************
  8053. OBJ_MFER = 'MODE' FER 'THERMIQUE' 'ISOTROPE' ;
  8054. 'SI' ( 'EXISTE' ETAB 'IMPOSE');
  8055. FF1 = QTE_FLUX 'ET' VAL_IMPO ;
  8056. 'SINON';
  8057. FF1 = QTE_FLUX;
  8058. 'FINSI';
  8059. ome= ETAB.'OME' ;
  8060. 'SI' ('NON' ( 'EXISTE' ETAB 'POTENTIEL')) ;
  8061. MESS '*************************************************************';
  8062. MESS '************** CALCUL INITIAL *******************************';
  8063. MESS 'SUPPOSE UN PASSAGE PREALABLE AU MOINS DS POT_VECT OU POT_SCAL';
  8064. MESS '*************************************************************';
  8065. klast= manu chpo fer 1 'SCAL' ( prog ( fer nbno ) * val_cond );
  8066. SI ( AXI ) ;
  8067. KLAST = (KLAST * ( RFER ** -1. )) ;
  8068. CHAM_CND = CHAMELEM FER (KLAST 'NOMC' 'K') 'CARACTERISTIQUES';
  8069. SINON ;
  8070. CHAM_CND='MATE' OBJ_MFER 'K' VAL_COND ;
  8071. FINSI ;
  8072. CND1 = 'CONDUCTIVITE' OBJ_MFER CHAM_CND ;
  8073. 'SI' ( 'EXISTE' ETAB BLOCAGE ) ;
  8074. RIG1 = CND1 ET RIG_CON ET MAT_BLO ;
  8075. 'SINON';
  8076. RIG1 = CND1 ET RIG_CON ;
  8077. 'FINSI' ;
  8078. U1_T = 'RESOUDRE' RIG1 FF1 ;
  8079. ETAB.'POTENTIEL'= U1_T ENLEVER LX ;
  8080. * CI= (LUMP RIG1 ) * VEC1 ; C2= (LUMP RIG1 ( MOTS T )) * VEC1 ;
  8081. * CI = (C2 - CI ) NOMC 'SCAL';
  8082. SINON ;
  8083. MESS ' ******************************************************';
  8084. MESS ' ****************** REPRISE *****************';
  8085. MESS ' ******************************************************';
  8086. SI (EXISTE ETAB 'KLAST') ;
  8087. KLAST= ETAB.'KLAST' ;
  8088. SINON ;
  8089. klast= manu chpo fer 1 'SCAL' ( prog ( fer nbno ) * val_cond );
  8090. FINSI ;
  8091. U1_T = 'EXCO' ( ETAB.'POTENTIEL') 'T' 'NOID' 'T' ;
  8092. * CI = ETAB.'CI' ;
  8093. MESS ' menage ' ; MENAGE ;
  8094. FINSI ;
  8095. 'SI' ( NIV_MESS '>EG' 2 ) ;
  8096. 'SAUTER' 1 'LIGNE' ;
  8097. 'MESS' 'CHAMP THERMIQUE AVANT ITERATION ' ;
  8098. 'LISTE' U1_T ;
  8099. 'FINSI' ;
  8100. DAN= 1.;
  8101. *
  8102. MOESP='REA' ;
  8103. *
  8104. MESS ' AMAX AMIN DU/U ';
  8105. *
  8106. ***********************************************************
  8107. *--- ... ITERATIONS ...
  8108. ***********************************************************
  8109. NUM_ITE = 0 ;
  8110. IFOIS = 0 ;
  8111. 'REPETER' BOUC_1 ;
  8112. NUM_ITE = NUM_ITE + 1 ;
  8113. IFOIS = IFOIS + 1 ;
  8114. *
  8115. * calcul du champ dans le fer -----> modif de mufer
  8116. U1_FER=REDU U1_T FER ;
  8117. DERIV= CHAN CHPO ( GRAD OBJ_MFER U1_FER) OBJ_MFER;
  8118. SI ( AXI ) ;
  8119. DERIV = DERIV / RFER ;
  8120. FINSI ;
  8121. SI (EXISTE DERIV 'T,Z' ) ;
  8122. DAX= (EXCO DERIV 'T,X') NOMC SCAL;
  8123. DAY= (EXCO DERIV 'T,Y') NOMC SCAL;
  8124. DAZ= (EXCO DERIV 'T,Z') NOMC SCAL;
  8125. BB= (( DAY * DAY ) + ( DAX * DAX ) +( DAZ * DAZ )) ** .5 ;
  8126. BB= BB NOMC T ;
  8127. SINON ;
  8128. DAX= (EXCO DERIV 'T,X') NOMC SCAL ;
  8129. DAY= (EXCO DERIV 'T,Y') NOMC SCAL ;
  8130. BB= ((( DAY * DAY ) + ( DAX * DAX ) ) ** .5 ) NOMC T ;
  8131. FINSI ;
  8132.  
  8133. BMAX= MAXIMUM BB ;BMIN= MINI BB ;
  8134. MESS IFOIS MOESP ' ** CHAMP MAXI MINI FER ' BMAX BMIN ;
  8135. * SAUTER 1 LIGNE ;
  8136.  
  8137. K1 = 'IPOL' BB LIS_TEMP LIS_COND ;
  8138. K1= COLI (K1 NOMC 'SCAL') OME KLAST (1. - OME) ;
  8139. KLAST = K1 ;
  8140. K2 = 'NOMC' 'K' K1 ;
  8141. SI ( AXI ) ;
  8142. K2 = (K2 * ( RFER ** -1. )) NOMC 'K' ;
  8143. CHAM_CND = CHAMELEM FER K2 'CARACTERISTIQUES';
  8144. SINON ;
  8145. CHAM_CND = 'CHAMELEM' FER K2 'CARACTERISTIQUES' ;
  8146. FINSI ;
  8147. CND2 = 'CONDUCTIVITE' OBJ_MFER CHAM_CND ;
  8148. RR2= CND2 ET RIG_CON ;
  8149. RESID= ( FF1 - ( RR2 * U1_T ) ) ENLEVER 'FLX' ;
  8150. *
  8151. * tests de convergence
  8152. *
  8153. RESID= RESID NOMC 'SCAL';
  8154. NORES= (XTX RESID ) ** .5 ;
  8155. ERRMAX= MAXI ( ABS RESID ) ;
  8156. MAXA= MAXI U1_T ;MIXA= MINI U1_T ;
  8157. DETR RESID ;
  8158. MESS IFOIS MAXA MIXA DAN ;
  8159. *
  8160. *
  8161. 'SI' (( NUM_ITE 'EGA' NBRE_ITE ) 'OU' ( IFOIS 'EGA' 1 ) );
  8162. *****************************************************************
  8163. * --- REACTUALISATION DE LA MATRICE DE CONDUCTIVITE
  8164. *****************************************************************
  8165. MOESP='REA' ;
  8166. * CI= (LUMP RR2 ) * VEC1 ; C2= (LUMP RR2 ( MOTS T )) * VEC1 ;
  8167. * CI = (C2 - CI ) NOMC 'SCAL';
  8168. 'SI' ( 'EXISTE' ETAB BLOCAGE );
  8169. RIG1 = RR2 ET MAT_BLO ;
  8170. 'SINON';
  8171. RIG1 = RR2 ;
  8172. 'FINSI' ;
  8173. U2 = 'RESOUDRE' RIG1 FF1 ;
  8174. NUM_ITE = 0 ;
  8175. 'SINON' ;
  8176. *****************************************************************
  8177. * --- RE-EQUILIBRAGE DU SECOND MEMBRE
  8178. *****************************************************************
  8179. MOESP=' ' ;
  8180. FF2 = ( RIG1 * U1_T ) - ( RR2 * U1_T ) ;
  8181. FF3 = FF1 + FF2 ;
  8182. U2 = 'RESOUDRE' RIG1 FF3 ;
  8183. * 'DETR' CND2 ;DETR RR1 ; DETR RR2 ;
  8184. 'FINSI' ;
  8185. *****************************************************************
  8186. *****************************************************************
  8187. U2_T = 'EXCO' U2 'T' 'NOID' 'T' ;
  8188. *
  8189. 'SI' ( NIV_MESS '>EG' 2 ) ;
  8190. 'SAUTER' 1 'LIGNE' ;
  8191. 'MESS' 'CHAMP THERMIQUE A L ITERATION :' IFOIS ;
  8192. 'LISTE' U2_T ;
  8193. 'FINSI' ;
  8194. *
  8195. CDIF= U2_T - U1_T ;
  8196. DAN= (XTX CDIF) / ( XTX U1_T) ;
  8197. DAN = DAN ** .5 ;
  8198. *
  8199. * 'SI' ( ERROR < EPSILON ) ;
  8200. 'SI' ( DAN < EPSILON ) ;
  8201. CONVERGE = VRAI ;
  8202. 'SINON' ;
  8203. CONVERGE = FAUX ;
  8204. 'FINSI' ;
  8205. *
  8206. *--- LE CRITERE DE CONVERGENCE EST-IL SATISFAIT ?
  8207. MENAGE ;
  8208.  
  8209. 'SI' ( CONVERGE ) ;
  8210. 'SI' ( NIV_MESS '>EG' 1 ) ;
  8211. * 'SAUTER' 1 'LIGNE' ;
  8212. 'MESS' 'CONVERGENCE A L ITERATION :' IFOIS ;
  8213. 'MESS' 'CRITERE DE CONVERGENCE :' EPSILON ;
  8214. 'FINSI' ;
  8215. 'QUITTER' BOUC_1 ;
  8216. 'FINSI' ;
  8217. U1_T = U2_T ;
  8218. 'SI' ( 'EGA' IFOIS ITER_MAX ) ;
  8219. * 'SAUTER' 1 'LIGNE' ;
  8220. 'MESS' 'PAS DE CONVERGENCE A L ITERATION :' ITER_MAX ;
  8221. ETAB.CONV = CONVERGE ;
  8222. 'QUITTER' BOUC_1 ;
  8223. 'FINSI' ;
  8224. * ON FAIT LE MENAGE
  8225. 'FIN' BOUC_1 ;
  8226. ETAB.NBITER= IFOIS;
  8227. *
  8228. *--- ARCHIVAGE DES RESULTATS DANS "ETAB"
  8229. *
  8230. ETAB.'KLAST'= KLAST ;
  8231. ETAB.'POTENTIEL' = U2_T ;
  8232. * ETAB.'CI'= CI ;
  8233. 'SI' ( NIV_MESS '>EG' 1 ) ;
  8234. 'SAUTER' 1 'LIGNE' ;
  8235. 'MESS' '*** FIN DE LA PROCEDURE "MAG_NLIN" ***' ;
  8236. 'FINSI' ;
  8237. 'FIN' PROC ;
  8238. 'FINPROC' ETAB ;
  8239. ************************
  8240. **** H_B derniere modif 16/04/91
  8241. DEBPROC H_B MU0*FLOTTANT POT_SCAL/MOT;
  8242. * definition de la courbe mu de b ou h
  8243. * mu0 systeme mksa 4 pi 10-7 ;
  8244. MUVRA = 4. * 3.14159 * 1.E-7 ;RAP= MU0 / MUVRA ;
  8245. * B= PROG 0. 1.09 1.5 1.57 1.67 1.81 1.92 2.01 20.1 ;
  8246. * H= PROG 0. 300 800 1250 3000 8000 13000 20000 200000 ;
  8247.  
  8248. B= PROG 0. .8 1.2 1.4 1.5 PAS .05 2.15 2.175 2.2 2.25 2.28 2.3 2.3443 2.3996 2.4905 2.5627 2.6706 2.8498 3.2074 3.5644 4.2782 4.8134 5.7052 6.4186 7.4887 17.48 27.48 200. 400. 600. 10000. 30000.;
  8249. H= PROG 0. 159.2 294.4 501.3 795.8 1154. 1795. 2862. 4383. 6044. 8122. 10590. 13610. 17220. 21170. 26750. 33760. 43800. 52440. 66000. 99470. 120960. 141210. 169600. 212170. 283130. 339890. 425040. 566950. 850760. 1134600. 1702300. 2128000. 2837700. 3405100. 4256700. 12215578. 20174457. 155800000. 311600000. 467400000. 7.32E9 21.E9 ;
  8250. * TITRE ' COURBE H B A/M TESLAS ****** ';
  8251. * BHEVO=EVOL MANU 'H' H 'B' B ;
  8252. * DESS BHEVO;
  8253. * RECTIF POUR COHERENCE UNITES
  8254. H= H / RAP ;
  8255. H_1= ENLEVER H 1 ;B_1= ENLEVER B 1 ;
  8256. MUV= H_1 / B_1;TU= EXTRA MUV 1;MUV= ( PROG TU ) ET MUV ;
  8257. SI ('EXISTE' POT_SCAL );
  8258. BOBO= TEXTE ' MU F(H) POT SCAL ' ;
  8259. TITRE BOBO ;
  8260. REVOL = EVOL MANU 'TEMPERATURE ' H 'CONDUCTIVITE ' ( MUV ** -1.) ;
  8261. SINON ;
  8262. BOBO= TEXTE ' MU F(B) POT VECT ';
  8263. TITRE BOBO ;
  8264. REVOL=EVOL 'MANU' 'TEMPERATURE' B 'CONDUCTIVITE' MUV ;
  8265. FINSI ;
  8266. SAUTER 3 LIGNES ;
  8267. MESS BOBO ;
  8268. SAUTER 3 LIGNES ;
  8269. FINPROC REVOL ;
  8270. *
  8271. **** POT_SCAL derniere modif 10/02/92
  8272. DEBPROC POT_SCAL TABGEO*TABLE SOLIN/MOT ;
  8273. *********************************************************************
  8274. * procedure de mise en place des elements d un calcul 3d *
  8275. * magnetostatique potentiel scalaire reduit et total *
  8276. * DPHI zone de potentiel reduit *
  8277. * DPsI zone de potentiel total
  8278. ***** desciption du domaine dphi ( pas de super pour le moment)****
  8279. * TABGEO.'DPHI' = geometrie DPHI *
  8280. * TABGEO.'SEPPHI'= surface de separation appartient a DPHI
  8281. * attention pour le moment on doit verifier l orientation de la *
  8282. * normale a sepphi ( exterieure ) en attendant extension de flux *
  8283. * TABGEO.'B_ANTI' = partie de sepphi appartenant a la limite *
  8284. * TABGEO.'MUAIR' = mu0 *
  8285. * d antisymetrie pour B *
  8286. *******description du domaine dpsi **********************************
  8287. * on donne la descprition du fer puis une table tdolin de tables *
  8288. * contenant chacune la descrition d un sous domaine *
  8289. * TABGEO.'FER' =zone du fer appartient a DPSI
  8290. * TABGEO.'MUFER' = mufer ( mu0 * murelatif) valeur de depart *
  8291. * TABGEO.'TDOLIN'
  8292. * TDOLIN.I = TABLE STN *
  8293. * STN.'GEO' = maillage du sous domaine *
  8294. * STN.'MU' = permeabilite
  8295. * eventuellement *
  8296. * STN.'BLOCAGE'= type maillage *
  8297. * STN.'IMPOSE' = type chpoint *
  8298. * STN.'MAITRES' = type maillage *
  8299. * *
  8300. * TABGEO.'SEPPSI'= surface de separation appartient a DPSI *
  8301. * TABGEO.'ORIG' = point ou on impose PHI = PSI *
  8302. * TABGEO.'BLOQUE' = condition limite generale (sauf super elements) *
  8303. * TABGEO.'BIOT' = table contenant le champ de la bobine sur DPHI *
  8304. * TABGEO.'MAILSEG' = elements d aretes de sep_phi (optionnel) *
  8305. * la routine l etablira si il n existe pas *
  8306. * TABGEO.'LISMO1' = listmot de elements de volumes utilises *
  8307. * TABGEO.'LISMO2' = listmot de elements de surface utilises *
  8308. * SOLIN si present on calcule un la solution lineaire *
  8309. * si absent le premier pas sera fait dans MAG_NLIN *
  8310. * jm baze aout 90 *
  8311. *********************************************************************
  8312. MU0 = TABGEO.'MUAIR' ;
  8313. SI ( EXISTE TABGEO 'DPHI' ) ;
  8314. MESS '*************************************************************';
  8315. MESS '*********** POTENTIEL REDUIT ---- POTENTIEL TOTAL *********';
  8316. MESS '*************************************************************';
  8317. DPHI = TABGEO.'DPHI' ;
  8318. SEP_PHI= TABGEO.'SEPPHI';
  8319. B_ANTI = TABGEO.'B_ANTI';
  8320. SEP_PSI= TABGEO.'SEPPSI';
  8321. ORIG = TABGEO.'ORIG' ;
  8322. TABHT= TABGEO.'BIOT';
  8323. LIMO1= TABGEO.'LISMO1';
  8324. LIMO2= TABGEO.'LISMO2';
  8325. * reduction de biot et savart sur sep_phi
  8326. TABHS= TABLE ;
  8327. TABHS.1 = REDU ( TABHT.1 ) SEP_PHI ;
  8328. TABHS.2 = REDU ( TABHT.2 ) SEP_PHI ;
  8329. TABHS.3 = REDU ( TABHT.3 ) SEP_PHI ;
  8330. sauter 5 lignes ;
  8331. MMM= TEXTE ' THERMIQUE ISOTROPE ';
  8332. OBJPHI= MODE DPHI MMM;
  8333. MATPHI= MATE OBJPHI 'K' MU0 ; RIGCON=CONDUC OBJPHI MATPHI ;
  8334. MESS ' COORD POINT ORIGINE INTEGRATION DE V ';
  8335. LIST ORIG ;
  8336. sauter 5 lignes ;
  8337. MESS ' CALCUL DU FLUX DE HS SUR LES ELEMENTS FRONTIERE ';
  8338. NBLD= DIMENSION LIMO2 ;
  8339. MESS ' FLUX DE HS MU0 ';
  8340. TTTT= EXTR LIMO2 1 ;TTTI= EXTR LIMO1 1 ;
  8341. SEP_PHI1=SEP_PHI ELEM TTTI ;
  8342. FLHS = FL_HS SEP_PHI1 TABHS TTTT OBJPHI ;
  8343. SI ( EGA NBLD 2 ) ;
  8344. TTTT= EXTR LIMO2 2 ;TTTI= EXTR LIMO1 2 ;
  8345. SEP_PHI2=SEP_PHI ELEM TTTI ;
  8346. FLHS2 = FL_HS SEP_PHI2 TABHS TTTT OBJPHI;
  8347. FLHS = FLHS + FLHS2 ;
  8348. FINSI ;
  8349. * TEMPS PLACE ;
  8350. FLHS= FLHS * MU0 ;
  8351. FLURED = RESU FLHS ;
  8352. MESS ' RESULTANTE DU FLUX * MUO ' ( MAXI FLURED ) ;
  8353. sauter 5 lignes ;
  8354. * integration sur la surface de separation de l equation de
  8355. * de continuite tangentielle
  8356. SI ( 'EXISTE' TABGEO 'MAILSEG' ) ;
  8357. MAILSEG= TABGEO.'MAILSEG';
  8358. SINON ;
  8359. * decomposition de la surface de separation en element d aretes
  8360. MESS ' CALCUL DES ELEMENTS ARETES DE LA SEPARATION ';
  8361. RESEAU= B_ARETES SEP_PHI ;
  8362. imena = 50 ;
  8363. MAILSEG = ARBRE RESEAU IMENA ;
  8364. TABGEO.'MAILSEG'= MAILSEG ;
  8365. FINSI;
  8366. * TEMPS PLACE ;
  8367. MESS ' CALCUL DU SAUT DE POTENTIEL ';
  8368. METHOD = 1 ;
  8369. SAUTER 4 LIGNES ;
  8370. IMENA= 3 ;
  8371. SI (EGA METHOD 1) ;
  8372. MESS ' CALCUL PAR MINIMISATION ';
  8373. LLLL= IN_MINI MAILSEG TABHS ORIG B_ANTI ;
  8374. SINON;
  8375. MESS ' CALCUL PAR INTEGRATION ';
  8376. LLLL = ARBRE_IN SEP_PHI TABHS ORIG ;
  8377. FINSI ;
  8378. *****************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1
  8379. TABGEO.'LLLL'=LLLL ;
  8380. MESS ' FIN DE CALCUL DU SAUT DE POTENTIEL ';
  8381. *
  8382. SEP_PHI = CHAN POI1 SEP_PHI ;
  8383. SEP_RED= DIFF SEP_PHI B_ANTI;
  8384. LRED= REDU LLLL SEP_RED ;
  8385.  
  8386. RELT FDEPI= SAUT_POT SEP_RED SEP_PSI LRED ORIG ;
  8387. MESS ' FIN D APPLICATION DU SAUT DE POTENTIEL ';
  8388. *****************
  8389. RIGCON = RIGCON ET RELT ;RHS = FLHS ET FDEPI ;
  8390. *****************
  8391. * LIST FSAUT ;
  8392. sauter 5 lignes ;
  8393. * TEMPS PLACE ;
  8394. SINON ;
  8395. SAUTER 5 LIGNES ;
  8396. MESS '*************************************************************';
  8397. MESS '*********** DPHI N EXISTE PAS --> POTENTIEL TOTAL *********';
  8398. MESS '*************************************************************';
  8399. SAUTER 5 LIGNES ;
  8400. FINSI ;
  8401. **
  8402. DFER = TABGEO.'FER' ;
  8403. MUFER = TABGEO.'MUFER' ;
  8404.  
  8405. OBJ2=MODE DFER MMM;
  8406. MAT2= MATE OBJ2 'K' MUFER ; RIGFER=CONDUC OBJ2 MAT2 ;
  8407. * boucle sur les domaines lineaires non contenus dans dphi
  8408. SI ('EXISTE' TABGEO 'DOLIN' );
  8409. TDOLIN = TABGEO.'DOLIN' ;
  8410. III = INDEX TDOLIN ;
  8411. IDOM = 0 ;
  8412. REPETER BOUCDOM ;
  8413. IDOM = IDOM + 1 ;
  8414. SI ( 'NON' ( 'EXISTE' III IDOM )) ; QUITTER BOUCDOM ;FINSI ;
  8415. STN = TDOLIN.IDOM ;
  8416. LIST STN ;
  8417. GEO = STN.'GEO' ;OBJI= MODE GEO MMM ;
  8418. MUI = STN.'MU' ;
  8419. MATI= MATE OBJI 'K' MUI ; RIGO=CONDUC OBJI MATI ;
  8420. *
  8421. SI ( EXISTE STN 'BLOQUE' ) ;
  8422. ENC1 = BLOQUER (STN.'BLOQUE') 'T';
  8423. RIGO = RIGO ET ENC1 ;
  8424. FINSI ;
  8425. SI ( EXISTE STN 'IMPOSE' ) ;
  8426. CHIMP = (STN.'IMPOSE' ) NOMC 'T';
  8427. MAII = EXTR CHIMP MAILLAGE ;
  8428. RIMP = BLOQUER MAII 'T' ; FPOTI = DEPIMP RIMP CHIMP ;
  8429. RIGO = RIGO ET RIMP ;RHS = RHS ET FPOTI ;
  8430. FINSI ;
  8431. SI ( EXISTE STN 'MAITRES');
  8432. ******************************************************************
  8433. * construction eventuelle du super element
  8434. ******************************************************************
  8435. * attention ici si il y a une charge OU UN IMPOSE
  8436. SUP1 = SUPER 'RIGIDITE' RIGO ( STN.'MAITRES' ) ;
  8437. RIGCON = RIGCON ET ( EXTRA SUP1 'RIGI' ) ;
  8438. SINON ;
  8439. RIGCON = RIGCON ET RIGO ;
  8440. FINSI ;
  8441. FIN BOUCDOM ;
  8442. * fin de la boucle sur les table de domaines lineaires de dpsi
  8443. FINSI ;
  8444. *
  8445. SI( EXISTE TABGEO 'IMPOSE') ;
  8446. MESS ' CONDITION GENERALE IMPOSEE ' ;
  8447. CHIMG = (TABGEO.'IMPOSE' ) NOMC 'T';
  8448. MAIG = EXTR CHIMG MAILLAGE ;
  8449. RIMG = BLOQUER MAIG 'T' ; FPOTG = DEPIMP RIMG CHIMG ;
  8450. RIGCON = RIGCON ET RIMG ;RHS = RHS ET FPOTG ;
  8451. FINSI ;
  8452. *
  8453. SI (EXISTE TABGEO 'BLOQUE') ;
  8454. MESS ' CONDITION GENERALE BLOQUEE ' ;
  8455. ENCG = BLOQUER (TABGEO.'BLOQUE') 'T';
  8456. RIGCON= RIGCON ET ENCG ;
  8457. TABGEO.'BLOCAGE' = ENCG ;
  8458. FINSI ;
  8459. *
  8460. *
  8461. SI ( EXISTE SOLIN ) ;
  8462. MESS '********************************************************* ';
  8463. MESS '***************** CALCUL LINEAIRE ******************** ';
  8464. MESS '********************************************************* ';
  8465.  
  8466. RIGT = RIGCON ET RIGFER ;
  8467. TABGEO.'RHS'= RHS ;
  8468. TABGEO.'RIGCON'= RIGCON ;
  8469. TABGEO.'RIGFER'= RIGFER ;
  8470. SOL0= RESOU RIGT RHS ;
  8471. TABGEO.'POTENTIEL'=(ENLEVER SOL0 LX) ;
  8472. FINSI ;
  8473. *
  8474. FINPROC ;
  8475. **** A_HOMO derniere modif 10/02/92
  8476. DEBPROC A_HOMO AKN*LISTREEL RHARM*FLOTTANT RCIRC*FLOTTANT NHARM*ENTIER;
  8477. SAUTER 2 LIGNES ;
  8478. OPTION ELEM SEG2 ;
  8479. BDIP= EXTR AKN 1;BQUAD = EXTR AKN 2 ;G0 = BQUAD / RHARM ;
  8480. SAUTER 2 LIGNES ;
  8481. MESS '******************* BDIP ' BDIP ;
  8482. MESS '******************* BQUAD' BQUAD;
  8483. MESS '******************* G0 ' G0 ;
  8484. SAUTER 2 LIGNES ;
  8485. C2R = EXTR AKN 2 ;
  8486. K= 0 ;
  8487. REPETER BLOCC NHARM ;
  8488. K= K + 1; COK = EXTR AKN K ;
  8489. AKM= COK / ( RHARM ** (K - 1)) ;
  8490. CQUA= COK / C2R ;
  8491. CDIP = COK / BDIP;
  8492. MESS K AKM CQUA ;
  8493. FIN BLOCC ;
  8494. SAUTER 2 LIGNES ;
  8495. * ON CONSTRUIT UN CHPO SUR LE RAYON ANALYSE CE QUI SERA PRATIQUE POUR
  8496. * TRACER DES EVOLUTIONS ;
  8497. OP = RCIRC 0.;OO= 0. 0. ;
  8498. LSUP= D 10 OO OP;
  8499. NN= 11 ;
  8500. DX =2.;
  8501. X= -2. ;
  8502. IP=0 ;
  8503. REPETER BLOCA 11 ;
  8504. IP= IP + 1 ;
  8505. X =X + DX ; Z = X / RHARM ;
  8506. B = 0 ; G = G0 ; BQUAD = C2R * Z ;
  8507. K= 0 ;
  8508. REPETER BLOCB NHARM ;
  8509. K= K + 1 ; COK = EXTR AKN K ;
  8510. SI ( K EGA 1 ) ; B = B + COK ;SINON ;TERM= COK * ( Z ** (K - 1 ));
  8511. B= B + TERM ;
  8512. SI ( (K >EG 3 ) ET ( (ABS X ) >EG 1.E-4 ) );
  8513. G = G + (( TERM / X ) * (K - 1)) ;
  8514. FINSI ;
  8515. FINSI ;
  8516. FIN BLOCB ;
  8517. * SI (( ABS X ) >EG 1.E-4 ) ;
  8518. HQUAD= (B - BDIP - BQUAD ) /C2R ;
  8519. GQUAD= (G - G0 ) / G0 ;
  8520. HDIP = (B - BDIP) / BDIP ;
  8521. * FINSI;
  8522. SI ( IP EGA 1 ) ;
  8523. LHQ= PROG HQUAD ;LG= PROG G ;
  8524. LGQ = PROG GQUAD ; LB= PROG B;
  8525. SINON ;
  8526. LHQ= LHQ ET (PROG HQUAD ) ;LG= LG ET ( PROG G );
  8527. LGQ = LGQ ET (PROG GQUAD );LB= LB ET (PROG B );
  8528. FINSI ;
  8529. FIN BLOCA ;
  8530. SAUTER 2 LIGNES ;
  8531. CX= COOR 1 LSUP ;
  8532.  
  8533. TUTU= MANU CHPO LSUP 4 'B' LB 'DB/B' LHQ 'G' LG 'DG/G' LGQ ;
  8534. SAUTER 2 LIGNES ;
  8535. MESS ' ANALYSE CONFORME A HARMBIS ';
  8536. SAUTER 2 LIGNES ;
  8537. RECAP = CX ET TUTU ;
  8538. LIST RECAP ;
  8539. FINPROC ;
  8540. *
  8541. **** INT_COMP derniere modif janvier /92
  8542. 'DEBPROC' INT_COMP GEOP*MAILLAGE CCCC*CHPOINT GEOF*MAILLAGE ;
  8543. ************************************************************************
  8544. * interpolation d une composante sur un maillage *
  8545. * TYEL TYPE D ELEMENTS *
  8546. * entree cccc chpoint original a 1 composante de support geop *
  8547. * sortie chpo de support geof *
  8548. ************************************************************************
  8549. TYT = VALE ELEM ;
  8550. SI ( NON ( EGA TYT 'TRI3'));
  8551. GEOP = CHAN GEOP TRI3 ;
  8552. MESS 'ON PASSE EN TRI3 POUR UTLISER PROI ( DEGUEULASSE EN TRI6....)';
  8553. FINSI ;
  8554.  
  8555. OBS1 = AFFECT GEOP ( MODELE STANDARD ) TRI3 ;
  8556. CEL1 = PRCH CCCC OBS1 'NOEUD' ;
  8557. CRES = PROI GEOF CEL1 ;
  8558. FINPROC CRES ;
  8559. *
  8560. **** IDE_ELE derniere modif fevrier/92
  8561. DEBPROC IDE_ELE ;
  8562. **********************************************************************
  8563. * IDENTIFICATION DU TYPE D ELEMENTS UTILISES
  8564. **********************************************************************
  8565. TIDIM = VALE DIME ;
  8566. TVAL = VALE ELEM ;
  8567. SI ( EGA TIDIM 2 ) ;
  8568. SI (( EGA TVAL 'QUA8') 'OU' (EGA TVAL 'TRI6')) ;
  8569. TYEL = TEXTE 'QUA8' 'TRI6' ;
  8570. SINON ;
  8571. TYEL = TEXTE 'QUA4' 'TRI3' ;
  8572. FINSI ;
  8573. SINON ;
  8574. SI (( EGA TVAL 'CU20') 'OU' (EGA TVAL 'PRI16')) ;
  8575. TYEL = TEXTE 'CU20' 'PR15' 'TET10';
  8576. SINON ;
  8577. TYEL = TEXTE 'CUB8' 'PRI6' 'TET4';
  8578. FINSI ;
  8579. FINSI ;
  8580. FINPROC TYEL ;
  8581. **** MUAXI2 MODIFIE FEVRIER 92
  8582. DEBPROC MUAXI2 GEO*MAILLAGE MU*FLOTTANT IDI*ENTIER ;
  8583. ***********************************************************************
  8584. * SORTIE De CONDUCTIBILITE = 1/(MU*R) EN AXISYMETRIQUE *
  8585. * IDI = 1 sortie chamelem 'caracteristique au noeuds DEFAUT*
  8586. * IDI = 2 sortie chpo aux noeuds scalaire *
  8587. * IDI = 3 sortie chamelem au CDG *
  8588. * MODIFIEE FEVRIER 92 POUR P2 *
  8589. ***********************************************************************
  8590. IMET = 2 ;
  8591. SI ( EGA IMET 1 ) ;
  8592. * estimation de mu au noeuds en trichant sur l axe
  8593. RGEO = COOR 1 GEO ;
  8594. AXE= GEO POINTS DROITE (0. 0) (0. 10.) .05 ;
  8595. MUPO = (((RGEO + ((COOR 1 AXE) + 1.E-8)) ** -1. ) / MU ) NOMC 'K';
  8596. MATT= CHAMELEM GEO MUPO 'CARACTERISTIQUE' ;
  8597. FINSI ;
  8598. SI ( EGA IMET 2 ) ;
  8599. * estimation de mu aux cdg sans tricher sur l axe
  8600. OBMOD = MODE GEO THERMIQUE ISOTROPE ;
  8601. cp_rpoa = (coor 1 GEO ) ;
  8602. * chamelem des rayons aux cdg
  8603. ce_rpoa = CHAN 'CHAM' CP_RPOA OBMOD 'GRAVITE';
  8604. * chamelem des cdg reportes aux noeuds
  8605. RGEO = (CHAN CHPO OBMOD (CHAN 'NOEUD' OBMOD ce_rpoa )) ** -1.;
  8606. SI ( EGA IDI 1 ) ;
  8607. CHPMUGEO= ( (1./ MU ) * RGEO )NOMC 'K' ;
  8608. MATT= CHAMELEM GEO CHPMUGEO 'CARACTERISTIQUE' ;
  8609. * MESS ' 1/MU CHAMP ELEM TYPE CARACTERISTIQUE K ';
  8610. FINSI ;
  8611. SI (EGA IDI 2 ) ;
  8612. MESS ' 1/R AUX CDG REPORTES AUX NOEUDS SCALAIRE ';
  8613. MATT = RGEO ;
  8614. FINSI ;
  8615. SI (EGA IDI 3 ) ;
  8616. MESS ' 1/R CHAMP ELEM AUX CDG ';
  8617. MATT = CE_RPOA ;
  8618. FINSI ;
  8619. FINSI ;
  8620. FINPROC MATT ;
  8621. **** REMONT derniere modif 14 08 91
  8622. DEBPROC REMONT ETAB*TABLE POT*CHPOINT GEON*MAILLAGE FE/CHPOINT GEOMAIT*MAILLAGE ;
  8623. * POT SOLUTION
  8624. * GEON MAILLAGE AUTRE QUE LE SUPER
  8625. * GEOMAIT POINTS MAITRES
  8626. SI ( EXISTE ETAB 'SUPER' ) ;
  8627. SUPP= ETAB.'SUPER' ;
  8628. DSUP = SUPER 'DEPLA' SUPP POT ;
  8629. * ATTENTION SI IL Y AVAIT DES CHARGES DANS LE SUPER
  8630. RIGS = EXTRAI SUPP 'RIGT' ;
  8631. SI ( EXISTE FE ) ;
  8632. SOLSUP = RESOU RIGS ( DSUP ET FE ) ;
  8633. SINON ;
  8634.  
  8635. SOLSUP = RESOU RIGS DSUP ;
  8636. FINSI ;
  8637. GEOSUP = EXTR SOLSUP MAILLAGE 'NOMU' ;
  8638. SINON ;
  8639. ********************************************************
  8640. * autre methode eventuelle
  8641. ********************************************************
  8642. * TAIR2 = REDU SOL1 CAIR1 ;
  8643. * NN= CAIR1 NBNO ;CAIR1 = CHAN CAIR1 POI1 ;
  8644. * IP = 0 ;
  8645. * REPETER BBBB NN ;
  8646. * IP = IP + 1 ;PP = CAIR1 POINT IP ;
  8647. * CLIM = BLOQUER 'T' PP ; FP = DEPIMP CLIM ( EXTR TAIR2 'T' PP ) ;
  8648. * SI ( EGA IP 1 ); CLIMT = CLIM ;FPT = FP ;
  8649. * SINON ; CLIMT = CLIMT ET CLIM ; FPT = FPT ET FP ;FINSI ;
  8650. * FIN BBBB ;
  8651. * TIAIR2 = RESOU (RIGA ET CLIMT) ( FPT ET FE ) ;
  8652. FINSI ;
  8653. *
  8654. POIS= CHAN GEOSUP POI1 ;
  8655. AAA= DIFF POIS (CHAN GEOMAIT POI1 ) ;
  8656. SOLSU = REDU SOLSUP AAA ;
  8657. SOLT= ( POT + SOLSU ) ;
  8658. FINPROC SOLT ;
  8659. **** F_S2PI derniere modif 30/3/92
  8660. DEBPROC F_S2PI CHARM*MAILLAGE SCIRC*CHPOINT NN*ENTIER OO*POINT ;
  8661. VALIN = REDU SCIRC ( CHARM POINT INITIAL ) ;
  8662. VALFI = REDU SCIRC ( CHARM POINT FINAL ) ;
  8663. V1 = MAXI VALIN ;V2 = MAXI VALFI ;
  8664. K = -1 ;
  8665. SI (( V1 < V2 ) ET ( NUM NEG 1 )) ;
  8666. CHARM = INVE CHARM ;K = 1 ;
  8667. FINSI ;
  8668. 1P = CHARM POINT INITIAL ;2P = CHARM POINT FINAL ;
  8669. IP = 0 ;
  8670. REPETER BOUC (NN - 1 );
  8671. IP = IP + 1 ;
  8672. SI ( EGA IP 1 ) ;
  8673. SOL2 = (SCIRC PLUS (0. 0.)) * K ;
  8674. SINON ;
  8675. SOL2 = (SOL2 PLUS (0. 0.)) * K ;
  8676. FINSI ;
  8677. MAI2 = EXTR SOL2 MAILLAGE ;
  8678. PDOU = CHARM POINT FINAL ;
  8679. VALDOU = REDU SCIRC PDOU ;
  8680.  
  8681. MAI2 = DEPLACER MAI2 SYME DROITE OO PDOU ;
  8682. SI ( EGA IP 1 ) ;
  8683. CHARM2= ( INVE (CHARM SYME DROITE OO PDOU )) ;
  8684. SINON ;
  8685. CHARM2= ( INVE (CHARM2 SYME DROITE OO PDOU )) ;
  8686. FINSI ;
  8687. ELIM .0001 CHARM2 MAI2 ;
  8688. CONFONDRE ( CHARM POINT FINAL) ( CHARM2 POINT INITIAL ) ;
  8689. CHARM = CHARM ET CHARM2 ;
  8690. SCIRC = SCIRC + SOL2 - VALDOU ;
  8691. K = K * -1 ;
  8692. FIN BOUC ;
  8693. *
  8694. SUPO = CHARM ;
  8695. * TITRE ' SOLUTION SUR 2PI ';
  8696. * EVV1 = EVOL ROUG CHPO SCIRC 'T' CHARM ;
  8697. * titre ' evo '( dime evv1 ) 'supp ' ( supo nbno ) ;
  8698. * trac supo ;
  8699. * dess evv1 ;
  8700. FINPROC SCIRC SUPO ;
  8701. **** DDFOUR derniere modif 30/3/92
  8702. DEBPROC DDFOUR GEO*MAILLAGE CHARM*MAILLAGE NHARM*ENTIER SOL*CHPOINT RHARM*FLOTTANT ORIG/POINT LIS*LOGIQUE ;
  8703. *********************************************************************
  8704. * ANALYSE HARMONIQUE DU POTENTIEL VECTEUR
  8705. * GEO MAILLAGE SUPPORT SOLUTION GENERALE *
  8706. * CHARM ARC DE CERCLE SUR LEQUEL ON A LE POTENTIEL *
  8707. * NHARM NOMBRE D HARMONIQUES A CALCULER *
  8708. * SOL SOLUTION EN POTENTIEL *
  8709. * RHARM RAYON DE NORMALISATION *
  8710. * ORIG ORIGINE CERCLE D ANALYSE
  8711. * LIS LOGIQUE FAUX SI PAS DE LISSAGE POLYNOMIAL *
  8712. *********************************************************************
  8713. 1P = CHARM POINT INITIAL ;2P= CHARM POINT FINAL ;
  8714. SI ( EXISTE ORIG ) ;
  8715. RCIRC = NORM ( 1P MOINS ORIG ) ;
  8716. SINON ;
  8717. RCIRC = NORM 1P ;ORIG = 0. 0. ;
  8718. FINSI ;
  8719. X1 Y1 = COOR ( 1P MOINS ORIG );X2 Y2 = COOR 2P ;
  8720. PT = 2P PROJETER (( Y1 * -1. ) X1 ) DROITE ORIG 1P ;
  8721. H = NORM ( 2P MOINS PT ) ;
  8722. SI ( (X1 + X2 ) < 1.E-3 ) ;
  8723. NUM = 2 ;
  8724. MESS 'SOLUTION DONNEE SUR 180 DEGRES ' ;
  8725. SINON ;
  8726. ANG = ATG H ( NORM ( PT MOINS ORIG)) ;
  8727. NUM = ( ENTI ( 360.1 / ANG )) ;
  8728. MESS 'SOLUTION DONNEE SUR ' ANG ' DEGRES ' ;
  8729. FINSI ;
  8730. SI ( NON ( LIS )) ;
  8731. SCIRC = INT_COMP GEO SOL CHARM ;
  8732. SCIRC = SCIRC NOMC 'T' ;
  8733. SINON ;
  8734. * lissage polynomial
  8735. CHLI = LISS GEO CHARM SOL 2 PLAN ;
  8736. SCIRC = (EXCO CHLI 'A' ) NOMC 'T' ;
  8737. FINSI ;
  8738. RRAP = RHARM / RCIRC ;
  8739. CQTT RTOT = F_S2PI CHARM SCIRC NUM ORIG ;
  8740. EQTT = EVOL ROUG CHPO CQTT 'T' RTOT ;
  8741. AAAA= EXTR EQTT 'ABSC' ;
  8742. * QTOT= EXTR EQTT 'ORDO' ;
  8743. * LIST QTOT ;
  8744. * NI1= (DIME AAAA ) - 1 ;
  8745. * IVAL = VALE ELEM ;
  8746. * OPTION ELEM SEG2 ;I1 = 0. 0. ; I2 = 360. 0. ;
  8747. * RTOT = DROI NI1 I1 I2 ;
  8748. OBA_RMA= AFFECTE RTOT (MODELE STANDARD) COQ2;
  8749. PERIOD= MAXI AAAA ;
  8750. MULT= 360. / PERIOD ;
  8751. ANGVEC= AAAA * MULT ;
  8752. * MESS ' PERIODE ' PERIOD ;
  8753. N=0;
  8754. MESS ' ANALYSE CONFORME A POISSON HARMON ';
  8755. MESS ' HARMONIQUE POTENTIEL CHAMP ';
  8756. MESS ' NOMBRE DE SEGMENTS DE DR ' NI1 ;
  8757. MESS ' DIME DE ANGVEC ' ( DIME ANGVEC ) ;
  8758. CHPA= MANU CHPO RTOT 1 SCAL ANGVEC ;
  8759. * CQTT = MANU CHPO RTOT 1 'POT' QTOT ;
  8760. REPETER BLOCIT NHARM ;
  8761. N= N + 1 ;
  8762. RAN= RRAP ** N ;
  8763. ANGLEN= CHPA * N ;
  8764. CNX= COS ANGLEN ;
  8765. SNX= SIN ANGLEN ;
  8766. EVREL= CQTT * CNX ;EVIMA= CQTT * SNX ;
  8767. CEVREL = PRCH EVREL OBA_RMA 'RIGIDITE' ;
  8768. CEVIMA = PRCH EVIMA OBA_RMA 'RIGIDITE' ;
  8769. AK= (( INTG CEVREL ) / PERIOD ) * 2. * RAN ;
  8770. BK= (( INTG CEVIMA ) / PERIOD ) * 2. * RAN ;
  8771. CK= (( AK * AK ) + ( BK * BK ) ) ** .5 ;
  8772. FF= ( FLOT N) / RHARM ;
  8773. AKK= AK * FF ;
  8774. BKK= BK * FF ;
  8775. CKK= CK * FF ;
  8776. SI (N EGA 1 );AKN= PROG AKK ; SINON ;AKN = AKN ET (PROG AKK ) ; FINSI ;
  8777. SAUTER 1 LIGNE ;
  8778. * MESS N AK BK CK AKK BKK CKK ;
  8779. MESS N AK BK CK ;
  8780. MESS N AKK BKK CKK ;
  8781. FIN BLOCIT ;
  8782. * OPTION ELEM IVAL ;
  8783. FINPROC AKN ANGVEC ;
  8784. *****
  8785.  
  8786. **** @DEFMAT
  8787. DEBPROC @DEFMAT TAB1*TABLE ;
  8788. *23456789012345678901234567890123456789012345678901234567890123456789012
  8789. * 1 2 3 4 5 6 7
  8790. ************************************************************************
  8791. MESS '---------------------------------> Entree dans DEFMAT ' ;
  8792.  
  8793. * on initialise des evol nuls
  8794. EVMA1 = EVOL MANU ( PROG 0. 500.) ( PROG 0. 0. ) ;
  8795. EVMA2 = EVOL MANU ( PROG 0. 500.) ( PROG 0. 0. ) ;
  8796. EVMA3 = EVOL MANU ( PROG 0. 500.) ( PROG 0. 0. ) ;
  8797. EVMA4 = EVOL MANU ( PROG 0. 500.) ( PROG 0. 0. ) ;
  8798. EVMA5 = EVOL MANU ( PROG 0. 500.) ( PROG 0. 0. ) ;
  8799. CHP_TM1 = TAB1.>CHP_TM1 ;
  8800. TAB1.TETMAT = TABLE ;
  8801. TAB1.MODL_MAT = TABLE ;
  8802. TAB1.MAT_MAT = TABLE ;
  8803.  
  8804. I1 = 0 ;
  8805. REPETER BOMA11 ;
  8806. I1 = I1 + 1 ;
  8807. *>1
  8808. SI ( EXISTE (TAB1.ZONE_MAT) I1 ) ;
  8809. NOM_MAT1 = TAB1.NOM_MAT.I1 ;
  8810. MESS '>>>> MATERIAU ' I1 NOM_MAT1 ;
  8811. TMECA_I1 = TEXT TAB1.TEXTMECA.I1 ;
  8812. MO1 = MODE TAB1.ZONE_MAT.I1 TMECA_I1 ;
  8813. TAB1.MODL_MAT. I1 = MO1 ;
  8814. TITRE NOM_MAT1 ' YOUN MODULUS ' ;
  8815. TAB1.TETMAT.MO1 = TABLE ;
  8816.  
  8817. *>>2*************** orthotropie
  8818.  
  8819. SI ( EGA TAB1.TEXTMECA.I1 ' MECANIQUE ELASTIQUE ORTHOTROPE') ;
  8820. CHAYGI= CHAINE TAB1 . TEXTMECA .(I1 + 100) ;
  8821. MESS '>>> ORTHOTROPIE' TAB1.TEXTMECA.I1 ;
  8822. MESS '>>> DIRECTIONS D ORTHOTROPIE' CHAYGI ;
  8823.  
  8824. * P1 = TAB1.DIRECT1 ;
  8825. * P2 = TAB1.DIRECT2 ;
  8826. * CHAYGI = 'DIRECTION P1 P2 ' ;
  8827. * CHADIR = 'DIRECTION TAB1.DIRECT1 TAB1.DIRECT2' ;
  8828.  
  8829. SI ( NON ( EXISTE TAB1 'MOMATR')) ;
  8830. TAB1.'MOMATR' = TABLE ;
  8831. FINSI ;
  8832. TAB1.'MOMATR'.MO1 = TAB1.TEXTMECA.(I1 + 100) ;
  8833.  
  8834. * CHAYG1 = CHAINE CHADIR ' YG1 ' ;
  8835. * CHAYG2 = CHAINE CHADIR ' YG2 ' ;
  8836. * CHAYG3 = CHAINE CHADIR ' YG3 ' ;
  8837. * CHAG12 = CHAINE CHADIR ' G12 ' ;
  8838. * CHAG23 = CHAINE CHADIR ' G23 ' ;
  8839. * CHAG13 = CHAINE CHADIR ' G13 ' ;
  8840. * CHANU12 = CHAINE CHADIR ' NU12 ' ;
  8841. * CHANU23 = CHAINE CHADIR ' NU23 ' ;
  8842. * CHANU13 = CHAINE CHADIR ' NU13 ' ;
  8843. * CHAALP12 = CHAINE CHADIR ' ALP1 ' ;
  8844. * CHAALP23 = CHAINE CHADIR ' ALP2 ' ;
  8845. * CHAALP13 = CHAINE CHADIR ' ALP3 ' ;
  8846.  
  8847. *>>3*************** orthotropie 333333333333333DDDDDDDDDD
  8848.  
  8849. SI (EGA (VALEUR DIMENSION) 3 ) ;
  8850. TAB1.TETMAT.MO1.YG1 = @EVMAT TAB1.NOM_MAT.I1 'YG1' TAB1 ;
  8851. TAB1.TETMAT.MO1.YG2 = @EVMAT TAB1.NOM_MAT.I1 'YG2' TAB1 ;
  8852. TAB1.TETMAT.MO1.YG3 = @EVMAT TAB1.NOM_MAT.I1 'YG3' TAB1 ;
  8853. EVMA1 = EVMA1 ET TAB1.TETMAT.MO1.YG1 ET TAB1.TETMAT.MO1.YG2 ET TAB1.TETMAT.MO1.YG3 ;
  8854. TITRE NOM_MAT1 ' POISSON COEFFICIENT ' ;
  8855. TAB1.TETMAT.MO1.NU12 = @EVMAT TAB1.NOM_MAT.I1 'NU12' TAB1 ;
  8856. TAB1.TETMAT.MO1.NU23 = @EVMAT TAB1.NOM_MAT.I1 'NU23' TAB1 ;
  8857. TAB1.TETMAT.MO1.NU13 = @EVMAT TAB1.NOM_MAT.I1 'NU13' TAB1 ;
  8858. EVMA2 = EVMA2 ET TAB1.TETMAT.MO1.NU12 ET TAB1.TETMAT.MO1.NU23 ET TAB1.TETMAT.MO1.NU13 ;
  8859. TITRE NOM_MAT1 ' THERMAL EXPANSION ' ;
  8860. TAB1.TETMAT.MO1.ALP1 = @EVMAT TAB1.NOM_MAT.I1 'ALP1' TAB1 ;
  8861. TAB1.TETMAT.MO1.ALP2 = @EVMAT TAB1.NOM_MAT.I1 'ALP2' TAB1 ;
  8862. TAB1.TETMAT.MO1.ALP3 = @EVMAT TAB1.NOM_MAT.I1 'ALP3' TAB1 ;
  8863. EVMA3 = EVMA3 ET TAB1.TETMAT.MO1.ALP1 ET TAB1.TETMAT.MO1.ALP2 ET TAB1.TETMAT.MO1.ALP3;
  8864. TAB1.TETMAT.MO1.G12 = @EVMAT TAB1.NOM_MAT.I1 'G12' TAB1 ;
  8865. TAB1.TETMAT.MO1.G23 = @EVMAT TAB1.NOM_MAT.I1 'G23' TAB1 ;
  8866. TAB1.TETMAT.MO1.G13 = @EVMAT TAB1.NOM_MAT.I1 'G13' TAB1 ;
  8867. TM_1 = ( REDU CHP_TM1 TAB1.ZONE_MAT.I1 ) ;
  8868. *
  8869. *** DIRECTION 1
  8870. *
  8871. Y_1 = VARI TM_1 TAB1.TETMAT.MO1.YG1 YG1 ;
  8872. G_1 = VARI TM_1 TAB1.TETMAT.MO1.G12 G12 ;
  8873. N_1 = VARI TM_1 TAB1.TETMAT.MO1.NU12 NU12 ;
  8874. A_1 = VARI TM_1 TAB1.TETMAT.MO1.ALP1 ALP1 ;
  8875. *
  8876. N_1 = CHANGER CHAM N_1 MO1 'RIGIDITE' ;
  8877. Y_1 = CHANGER CHAM Y_1 MO1 'RIGIDITE' ;
  8878. G_1 = CHANGER CHAM G_1 MO1 'RIGIDITE' ;
  8879. A_1 = CHANGER CHAM A_1 MO1 'RIGIDITE' ;
  8880. *
  8881. *** DIRECTION 2
  8882. *
  8883. Y_2 = VARI TM_1 TAB1.TETMAT.MO1.YG2 YG2 ;
  8884. G_2 = VARI TM_1 TAB1.TETMAT.MO1.G23 G23 ;
  8885. N_2 = VARI TM_1 TAB1.TETMAT.MO1.NU23 NU23 ;
  8886. A_2 = VARI TM_1 TAB1.TETMAT.MO1.ALP2 ALP2 ;
  8887. *
  8888. N_2 = CHANGER CHAM N_2 MO1 'RIGIDITE' ;
  8889. Y_2 = CHANGER CHAM Y_2 MO1 'RIGIDITE' ;
  8890. G_2 = CHANGER CHAM G_2 MO1 'RIGIDITE' ;
  8891. A_2 = CHANGER CHAM A_2 MO1 'RIGIDITE' ;
  8892. *
  8893. *** DIRECTION 3
  8894. *
  8895. Y_3 = VARI TM_1 TAB1.TETMAT.MO1.YG3 YG3 ;
  8896. G_3 = VARI TM_1 TAB1.TETMAT.MO1.G13 G13 ;
  8897. N_3 = VARI TM_1 TAB1.TETMAT.MO1.NU13 NU13 ;
  8898. A_3 = VARI TM_1 TAB1.TETMAT.MO1.ALP3 ALP3 ;
  8899. *
  8900. N_3 = CHANGER CHAM N_3 MO1 'RIGIDITE' ;
  8901. Y_3 = CHANGER CHAM Y_3 MO1 'RIGIDITE' ;
  8902. G_3 = CHANGER CHAM G_3 MO1 'RIGIDITE' ;
  8903. A_3 = CHANGER CHAM A_3 MO1 'RIGIDITE' ;
  8904. *
  8905. TEX1 = TEXT CHAYGI ' YG1 Y_1 YG2 Y_2 YG3 Y_3' ;
  8906. TEX2 = TEXT CHAYGI ' G12 G_1 G23 G_2 G13 G_3' ;
  8907. TEX3 = TEXT CHAYGI ' NU12 N_1 NU23 N_2 NU13 N_3' ;
  8908. TEX4 = TEXT CHAYGI ' ALP1 A_1 ALP2 A_2 ALP3 A_3' ;
  8909. SINON ;
  8910.  
  8911. *>>3*************** orthotropie 222222222222222 DDDDDDDDDD
  8912.  
  8913. TAB1.TETMAT.MO1.YG1 = @EVMAT TAB1.NOM_MAT.I1 'YG1' TAB1 ;
  8914. TAB1.TETMAT.MO1.YG2 = @EVMAT TAB1.NOM_MAT.I1 'YG2' TAB1 ;
  8915. EVMA1 = EVMA1 ET TAB1.TETMAT.MO1.YG1 ET TAB1.TETMAT.MO1.YG2 ;
  8916.  
  8917. TITRE NOM_MAT1 ' POISSON COEFFICIENT ' ;
  8918. TAB1.TETMAT.MO1.NU12 = @EVMAT TAB1.NOM_MAT.I1 'NU12' TAB1 ;
  8919.  
  8920. EVMA2 = EVMA2 ET TAB1.TETMAT.MO1.NU12 ;
  8921.  
  8922. TITRE NOM_MAT1 ' THERMAL EXPANSION ' ;
  8923. TAB1.TETMAT.MO1.ALP1 = @EVMAT TAB1.NOM_MAT.I1 'ALP1' TAB1 ;
  8924. TAB1.TETMAT.MO1.ALP2 = @EVMAT TAB1.NOM_MAT.I1 'ALP2' TAB1 ;
  8925. EVMA3 = EVMA3 ET TAB1.TETMAT.MO1.ALP1 ET TAB1.TETMAT.MO1.ALP2 ;
  8926. TAB1.TETMAT.MO1.G12 = @EVMAT TAB1.NOM_MAT.I1 'G12' TAB1 ;
  8927. TM_1 = ( REDU CHP_TM1 TAB1.ZONE_MAT.I1 ) ;
  8928. *
  8929. *** DIRECTION 1
  8930. *
  8931. Y_1 = VARI TM_1 TAB1.TETMAT.MO1.YG1 YG1 ;
  8932. G_1 = VARI TM_1 TAB1.TETMAT.MO1.G12 G12 ;
  8933. N_1 = VARI TM_1 TAB1.TETMAT.MO1.NU12 NU12 ;
  8934. A_1 = VARI TM_1 TAB1.TETMAT.MO1.ALP1 ALP1 ;
  8935. *
  8936. N_1 = CHANGER CHAM N_1 MO1 'RIGIDITE' ;
  8937. Y_1 = CHANGER CHAM Y_1 MO1 'RIGIDITE' ;
  8938. G_1 = CHANGER CHAM G_1 MO1 'RIGIDITE' ;
  8939. A_1 = CHANGER CHAM A_1 MO1 'RIGIDITE' ;
  8940. *
  8941. *** DIRECTION 2
  8942. *
  8943. Y_2 = VARI TM_1 TAB1.TETMAT.MO1.YG2 YG2 ;
  8944. A_2 = VARI TM_1 TAB1.TETMAT.MO1.ALP2 ALP2 ;
  8945. Y_2 = CHANGER CHAM Y_2 MO1 'RIGIDITE' ;
  8946. A_2 = CHANGER CHAM A_2 MO1 'RIGIDITE' ;
  8947.  
  8948. TEX1 = TEXT CHAYGI ' YG1 Y_1 YG2 Y_2 ' ;
  8949. TEX2 = TEXT CHAYGI ' G12 G_1 ' ;
  8950. TEX3 = TEXT CHAYGI ' NU12 N_1 ' ;
  8951. TEX4 = TEXT CHAYGI ' ALP1 A_1 ALP2 A_2 ' ;
  8952. FINSI ;
  8953. ** MA1 = MATE MO1 (TEXT CHAYG1 ' Y_1 ' ) ;
  8954. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYG2 ' Y_2 ')) ;
  8955. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYG3 ' Y_3 ')) ;
  8956. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYG12 ' G_1' )) ;
  8957. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYG23 ' G_2' )) ;
  8958. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYG13 ' G_3' )) ;
  8959. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYNU12 ' N_1' )) ;
  8960. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYNU23 ' N_2' )) ;
  8961. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYNU13 ' N_3' )) ;
  8962. ;
  8963. MA1 = MATE MO1 TEX1 (TEXT TAB1 . TEXTMECA . 101 ) ;
  8964. MA2 = MATE MO1 TEX2 (TEXT TAB1 . TEXTMECA . 101 ) ;
  8965. MA3 = MATE MO1 TEX3 (TEXT TAB1 . TEXTMECA . 101 ) ;
  8966. MA4 = MATE MO1 TEX4 (TEXT TAB1 . TEXTMECA . 101 ) ;
  8967. MA1 = MA1 ET MA2 ET MA3 ET MA4 ;
  8968.  
  8969. *>>2 ************* Isotropie
  8970.  
  8971.  
  8972. SINON ;
  8973. MESS '>>> NON ORTHO' TAB1.TEXTMECA.I1 ;
  8974. TITRE NOM_MAT1 ' YOUNG MODULUS ' ;
  8975. TAB1.TETMAT.MO1.YOUN = @EVMAT TAB1.NOM_MAT.I1 'YOUN' TAB1 ;
  8976. EVMA1 = EVMA1 ET TAB1.TETMAT.MO1.YOUN ;
  8977. TITRE NOM_MAT1 ' POISSON COEFFICIENT ' ;
  8978. TAB1.TETMAT.MO1.NU = @EVMAT TAB1.NOM_MAT.I1 'NU' TAB1;
  8979. EVMA2 = EVMA2 ET TAB1.TETMAT.MO1.NU ;
  8980. TITRE NOM_MAT1 ' THERMAL EXPANSION ' ;
  8981. TAB1.TETMAT.MO1.ALPH = @EVMAT TAB1.NOM_MAT.I1 'ALPH' TAB1;
  8982. EVMA3 = EVMA3 ET TAB1.TETMAT.MO1.ALPH ;
  8983. TM_1 = ( REDU CHP_TM1 TAB1.ZONE_MAT.I1 ) ;
  8984. Y_1 = VARI TM_1 TAB1.TETMAT.MO1.YOUN YOUN ;
  8985. NU_1 = VARI TM_1 TAB1.TETMAT.MO1.NU NU ;
  8986. AL_1 = VARI TM_1 TAB1.TETMAT.MO1.ALPH ALPH ;
  8987. NU_1 = CHANGER CHAM NU_1 MO1 'RIGIDITE' ;
  8988. Y_1 = CHANGER CHAM Y_1 MO1 'RIGIDITE' ;
  8989. AL_1 = CHANGER CHAM AL_1 MO1 'RIGIDITE' ;
  8990. TEX1 = TEXTE ' YOUN Y_1 NU NU_1 ALPH AL_1 ' ;
  8991. MA1 = MATE MO1 TEX1 ;
  8992. FINSI ;
  8993. *>>2
  8994. IMOTM1 = DIME (MOTS TMECA_I1) ;
  8995. SI ( IMOTM1 EGA 5 ) ;
  8996. TITRE NOM_MAT1 ' YIELD STRESS ' ;
  8997. TAB1.TETMAT.MO1.SIGY = @EVMAT TAB1.NOM_MAT.I1 'SIGY' TAB1 ;
  8998. EVMA4 = EVMA4 ET TAB1.TETMAT.MO1.SIGY ;
  8999. TEX1 = TEXTE TEX1 ' SIGY YM_1 ' ;
  9000. TITRE NOM_MAT1 ' YIELD MODULUS' ;
  9001. YM_1 = VARI TM_1 TAB1.TETMAT.MO1.SIGY SIGY ;
  9002. YM_1 = CHANGER CHAM YM_1 MO1 'RIGIDITE' ;
  9003. TAB1.TETMAT.MO1.H = @EVMAT TAB1.NOM_MAT.I1 'H' TAB1 ;
  9004. EVMA5 = EVMA5 ET TAB1.TETMAT.MO1.H ;
  9005. H_1 = VARI TM_1 TAB1.TETMAT.MO1.H H ;
  9006. H_1 = CHANGER CHAM H_1 MO1 'RIGIDITE' ;
  9007. TEX1 = TEXTE TEX1 'H H_1 ' ;
  9008. MA1 = MATE MO1 TEX1 ;
  9009. * TEMP IMPR PLACE ;
  9010. * MENAGE ;
  9011.  
  9012. @TRCPLAS TAB1 MO1 I1 ;
  9013. TEX5 = TEXT ' MA1 = MATE MO1 ' ;
  9014. * TEX5 TEX1 TEX2 TEX3 TEX4 ;
  9015. FINSI;
  9016. *>1
  9017. SINON ;
  9018. QUITTER BOMA11 ;
  9019. FINSI ;
  9020. *>1
  9021. SI ( I1 EGA 1 ) ;
  9022. MOD_1 = MO1 ;
  9023. MAT_1 = MA1 ;
  9024. SINON ;
  9025. MOD_1 = MOD_1 ET MO1 ;
  9026. MAT_1 = MAT_1 ET MA1 ;
  9027. FINSI ;
  9028. TAB1.MAT_MAT.I1 = MA1 ;
  9029. FIN BOMA11 ;
  9030. TAB1.MATTOT = MAT_1 ;
  9031. TAB1.MODTOT = MOD_1 ;
  9032. TAC8 = TABLE ;
  9033. TAC8.1 = ' NOLI ' ;
  9034. TAC8.2 = 'MARQ PLUS REGU' ;
  9035. TAC8.3 = 'MARQ ETOI REGU' ;
  9036. TAC8.4 = 'MARQ LOSA REGU' ;
  9037. TAC8.5 = 'MARQ CARR REGU' ;
  9038. TAC8.6 = 'MARQ TRIA REGU' ;
  9039. TAC8.7 = 'MARQ TRIB REGU' ;
  9040. TAC8.8 = 'MARQ PLUS REGU' ;
  9041. TAC8.9 = 'MARQ ETOI REGU' ;
  9042. TAC8.10 = 'MARQ CROI REGU' ;
  9043. DESS EVMA1 XBOR 0. 2000. LEGE MIMA DATE TAC8 ;
  9044. DESS EVMA2 XBOR 0. 2000. LEGE MIMA DATE TAC8 ;
  9045. DESS EVMA3 XBOR 0. 2000. LEGE MIMA DATE TAC8 ;
  9046. DESS EVMA4 XBOR 0. 2000. LEGE MIMA DATE TAC8 ;
  9047. DESS EVMA5 XBOR 0. 2000. LEGE MIMA DATE TAC8 ;
  9048. MESS ' >>>>>>> fin materiaux' ;
  9049. MO1 = TAB1.MODL_MAT.1 ;
  9050. MA1 = TAB1.MAT_MAT.1 ;
  9051. CHAEPXX = MANU 'CHML' MO1 EPXX 0.001 EPYY 0. EPZZ 0. GAXY 0. GAXZ 0. GAYZ 0. TYPE 'DEFORMATIONS' 'STRESSES' ;
  9052. HO11 = HOOK MO1 MA1 ;
  9053. CHASIXX = MO1 HO11 * CHAEPXX ;
  9054. MESS ' >>>****** MAXI MINI CONT ' (MAXI CHASIXX AVEC (MOTS SMXX)) (MINI CHASIXX AVEC (MOTS SMXX));
  9055. CHAEEXX = MO1 HO11 * CHASIXX ;
  9056. MESS ' >>>****** MAXI MINI CONT ' (MAXI CHAEEXX AVEC (MOTS EPXX)) (MINI CHAEEXX AVEC (MOTS EPXX));
  9057. MESS '---------------------------------> sortie de DEFMAT';
  9058. FINPROC ;
  9059. * *
  9060. * *
  9061. * *
  9062. * *
  9063. DEBPROC DEFORAPH LIGN_1*MAILLAGE INSTEVOL*FLOTTANT MOD1*MMODEL TAB1*TABLE SM1/EVOLUTION EM1/EVOLUTION VAL1/FLOTTANT VAL2/FLOTTANT;
  9064.  
  9065. MESS '-----------------------------------> entree dans DEFORAPH ' ;
  9066. *
  9067. * !!! NON ENCORE OPERATIONNEL !!!
  9068. *
  9069. MESS ' !!! NON ENCORE OPERATIONNEL !!! ' ;
  9070.  
  9071. DIM1 = VALEUR DIME ;
  9072.  
  9073. * test sur la dimension
  9074. SI (EGA DIM1 2);
  9075. MESS ' attention contraph ne tourne pas en 3D';
  9076. QUITTER CONTRAPH ;
  9077. * malgre le probleme de PROI en 3D, qui n a pas ete regle
  9078. * mais qu on accepte faute de mieux
  9079. FINSI;
  9080.  
  9081.  
  9082. SI (NON (EXISTE TAB1 RESUCONT)) ;
  9083. MESS ' TAB1 NE CONTIENT PAS DE CONTRAINTES ' ;
  9084. MESS ' SORTIE DE CONTRAPH ' ;
  9085. QUITTER CONTRAPH ;
  9086. FINSI ;
  9087.  
  9088. * test sur la dimension de LIGN_1*MAILLAGE : a faire
  9089.  
  9090. LCONFON = FAUX ;
  9091. MAIL_1 = MOD1 EXTR 'MAIL' ;
  9092. N_1 = NBNO MAIL_1 ;
  9093. N_2 = NBNO (MAIL_1 ET LIGN_1 ) ;
  9094.  
  9095. SI ( EGA N_1 N_2 ) ;
  9096. LCONFON = VRAI ;
  9097. FINSI ;
  9098.  
  9099. SI (NON(EXISTE TAB1 TETMAT)) ;
  9100. MESS ' TAB1 NE CONTIENT PAS DE TETMAT ' ;
  9101. MESS ' SORTIE DE CONTRAPH ' ;
  9102. QUITTER CONTRAPH ;
  9103. FINSI ;
  9104.  
  9105. SI (NON(EXISTE (TAB1.TETMAT) MOD1)) ;
  9106. MESS ' TAB1.TETMAT NE CONTIENT PAS DE MODELE ' ;
  9107. MESS ' SORTIE DE CONTRAPH ' ;
  9108. QUITTER CONTRAPH ;
  9109. FINSI ;
  9110.  
  9111. SI (NON(EXISTE (TAB1.TETMAT.MOD1) SIGY)) ;
  9112. MESS ' LE MATERIAU DEMANDE N EST PAS PLASTIQUE ' ;
  9113. MESS ' SORTIE DE CONTRAPH ' ;
  9114. QUITTER CONTRAPH ;
  9115. FINSI ;
  9116.  
  9117. TITR ' DEPOUILLEMENT LE LONG DE LA LIGNE ' ;
  9118. *
  9119. * --- Depouillement en deformation
  9120. *
  9121. DEPL1 = TAB1.RESUDEPL.INSTEVOL ;
  9122. TOTA1 = EPSI MOD1 (REDU DEPL1 (EXTR MOD1 MAIL)) ;
  9123. PLAS1 = EXCO ( TAB1.RESUVARI. INSTEVOL) EPSE ;
  9124.  
  9125. * --- METHODE 1
  9126. * evaluation de la deformation ELASTIQUE PAR ELAS
  9127. * caract pris contant egal a sa moyenne sur l'intervalle de T considere
  9128. * deduction de EPStherm
  9129. CONT1 = REDU (TAB1.RESUCONT.INSTEVOL) MOD1 ;
  9130. ELAS1_1 = ELAS MOD1 CONT1 (TAB1.MAT_MAT.3) ;
  9131.  
  9132.  
  9133.  
  9134. * --- METHODE 2
  9135. * evaluation de la deformation du a la thermique
  9136. * alpha pris contant egal a sa moyenne sur l'intervalle de T considere
  9137. * deduction de EPS elas
  9138. ID1 = INDE (TAB1.'CHPOTHETA') ;
  9139. CHT1 = TAB1.CHPOTHETA . INSTEVOL - (TAB1.CHPOTHETA. (ID1 . 1)) ;
  9140. CHT2 = (TAB1.CHPOTHETA. (ID1 . 1)) + (CHT1 / 2.) ;
  9141. ALPHA1 = VARI CHT2 TAB1.TETMAT.MOD1.'ALPH' ;
  9142. THER2_1 = ALPHA1 * (EXCO CHT1 'T') ;
  9143. THER2_2 = (CHAN CHAM THER2_1 (EXTR MOD1 MAIL) NOEUD) * -1. ;
  9144. THER2_2 = (CHAN CHAM THER2_1 (EXTR MOD1 MAIL) NOEUD) ;
  9145.  
  9146.  
  9147.  
  9148. * evaluation de la limite elastique exprimee en epsilon
  9149. * cette limite est egale a Re/E c'est a dire SIGY / YOUN en langage CASTEM
  9150. * le tout dependant de la temperature du point considere
  9151.  
  9152. CHYOUN1 = VARI TAB1.CHPOTHETA.INSTEVOL TAB1.TETMAT.MOD1.'YOUN' ;
  9153. CHSIGY1 = VARI TAB1.CHPOTHETA.INSTEVOL TAB1.TETMAT.MOD1.'SIGY' ;
  9154.  
  9155. CHYOUN2 = CHYOUN1 ** (-1) ;
  9156. CHSIGY2 = CHAN CHAM CHSIGY1 (EXTR MOD1 MAIL) NOEUD ;
  9157.  
  9158. CHYOUN3 = CHAN CHAM CHYOUN2 (EXTR MOD1 MAIL) NOEUD ;
  9159. CHSIGY3 = CHSIGY2 ;
  9160.  
  9161. LIMELAS1 = CHSIGY3 * CHYOUN3 ;
  9162.  
  9163.  
  9164. SI LCONFON ;
  9165. TOTA2 = CHAN 'CHPO' MOD1 TOTA1 ;
  9166. PLAS2 = CHAN 'CHPO' MOD1 (REDU PLAS1 MOD1) ;
  9167. LIMELAS2 = CHAN 'CHPO' MOD1 LIMELAS1 ;
  9168. THER2_3 = CHAN 'CHPO' MOD1 THER2_2;
  9169. ELAS1_2 = CHAN 'CHPO' MOD1 ELAS1_1 ;
  9170. SI (EXISTE EM1 ) ;
  9171. FINSI ;
  9172. SINON ;
  9173. TOTA2 = PROI LIGN_1 (CHAN NOEUD MOD1 TOTA1) ;
  9174. PLAS2 = PROI LIGN_1 (CHAN NOEUD MOD1 (REDU PLAS1 MOD1)) ;
  9175. LIMELAS2 = PROI LIGN_1 LIMELAS1 ;
  9176. ELAS1_2 = PROI LIGN_1 (CHAN NOEUD MOD1 ELAS1_1) ;
  9177. THER2_3 = PROI LIGN_1 THER2_2;
  9178. SI (EXISTE EM1) ;
  9179. FINSI ;
  9180. FINSI ;
  9181.  
  9182.  
  9183.  
  9184. SI (EGA DIM1 2) ;
  9185. EXX1 = EXCO EPSETOT2 EPXX ;
  9186. EYY1 = EXCO EPSETOT2 EPYY ;
  9187. GXY1 = EXCO EPSETOT2 GAXY ;
  9188. EPSETOT2 = ((2. ** .5 ) / 3.) * (( ((EXX1 - EYY1 ) ** 2) + 6 * ((GXY1 * 2. ) ** 2) ) ** .5);
  9189.  
  9190.  
  9191.  
  9192. SINON ;
  9193. EXX1 = EXCO TOTA2 EPXX ;
  9194. EYY1 = EXCO TOTA2 EPYY ;
  9195. EZZ1 = EXCO TOTA2 EPZZ ;
  9196. GXY1 = EXCO TOTA2 GAXY ;
  9197. GXZ1 = EXCO TOTA2 GAXZ ;
  9198. GYZ1 = EXCO TOTA2 GAYZ ;
  9199. TOTA3 = ((2. ** .5 ) / 3.) * ( ( ((EXX1 - EYY1 ) ** 2) + ((EXX1 - EZZ1 ) ** 2) + ((EYY1 - EZZ1 ) ** 2) + 6. * ( ((GXY1 / 2.) ** 2) + ((GXZ1 / 2.) ** 2) + ((GYZ1 / 2.)** 2) ) ) ** .5);
  9200. EXX1 = EXCO ELAS1_2 EPXX ;
  9201. EYY1 = EXCO ELAS1_2 EPYY ;
  9202. EZZ1 = EXCO ELAS1_2 EPZZ ;
  9203. GXY1 = EXCO ELAS1_2 GAXY ;
  9204. GXZ1 = EXCO ELAS1_2 GAXZ ;
  9205. GYZ1 = EXCO ELAS1_2 GAYZ ;
  9206. ELAS1_3 = ((2. ** .5 ) / 3.) * ( ( ((EXX1 - EYY1 ) ** 2) + ((EXX1 - EZZ1 ) ** 2) + ((EYY1 - EZZ1 ) ** 2) + 6. * (( (GXY1 / 2.) ** 2) + ((GXZ1 / 2.)** 2) + ((GYZ1 / 2.)** 2)) ) ** .5);
  9207.  
  9208.  
  9209. FINSI ;
  9210.  
  9211. THER1_1 = (EXCO TOTA3 SCAL) - (EXCO PLAS2 EPSE) - (EXCO ELAS1_3 SCAL) ;
  9212. ELAS2_1 = (EXCO TOTA3 SCAL) - (EXCO PLAS2 EPSE) - (EXCO THER2_3 (EXTR (EXTR THER2_3 COMP) 1)) ;
  9213.  
  9214. EVEL1 = EVOL CHPO ELAS1_3 LIGN_1 ;
  9215. EVEL2 = EVOL CHPO ELAS2_1 LIGN_1 ;
  9216. TAC1 = TABLE ;
  9217. TAC1.1 = 'MARQ LOSA REGU TITR METH1';
  9218. TAC1.3 = 'MARQ CROI REGU TITR METH2';
  9219. EVELL = EVEL1 ET EVEL2 ;
  9220. DESS EVELL LEGE TAC1 ;
  9221.  
  9222. EVET1 = EVOL CHPO THER1_1 LIGN_1 ;
  9223. EVET2 = EVOL CHPO THER2_3 LIGN_1 ;
  9224. TAC1 = TABLE ;
  9225. TAC1.1 = 'MARQ LOSA REGU TITR METH1';
  9226. TAC1.3 = 'MARQ CROI REGU TITR METH2';
  9227. EVETT = EVET1 ET EVET2 ;
  9228. DESS EVETT LEGE TAC1 ;
  9229.  
  9230.  
  9231.  
  9232. TITRE 'EPS_TOT' ;
  9233. EVTOT1 = EVOL CHPO EPSETOT2 LIGN_1 ;
  9234. TITRE 'EPS_PLAS' ;
  9235. EVPLAS1 = EVOL CHPO EPSPLAS2 LIGN_1 ;
  9236. TITRE 'EPS_THER' ;
  9237. EVTHER1 = EVOL CHPO EPSTHER3 LIGN_1 ;
  9238. TITRE 'LIM_ELAS' ;
  9239. EVLIEL1 = EVOL CHPO LIMELAS2 LIGN_1 ;
  9240.  
  9241. TAD1 = TABLE ;
  9242. TAD1.1 = CHAI 'MARQ CROI REGU TITR EPS_TOT' ;
  9243. TAD1.3 = CHAI 'MARQ ETOI REGU TITR EPS_PLAS ' ;
  9244. TAD1.5 = CHAI 'MARQ LOSA REGU TITR EPS_THER ' ;
  9245. TAD1.7 = CHAI 'MARQ TRIA REGU TITR LIM_ELAS ' ;
  9246. EVEPS1 = EVTOT1 ET EVPLAS1 ET EVTHER1 ET EVLIEL1 ;
  9247. DESS EVEPS1 LEGE MIMA TAD1 ;
  9248.  
  9249.  
  9250. MESS '-----------------------------------> sortie de DEFORAPH ' ;
  9251.  
  9252. FINPROC ;
  9253.  
  9254. **** @DEFO_EQ
  9255. DEBPROC @DEFO_EQ EPSE1*MCHAML MOD1*MMODEL ;
  9256. MESS '----------------------------> calling @DEFO_EQ';
  9257.  
  9258. EX1 = EXCO EPSE1 EPXX NOID SCAL ;
  9259. EY1 = EXCO EPSE1 EPYY NOID SCAL ;
  9260. EZ1 = EXCO EPSE1 EPZZ NOID SCAL ;
  9261. EG1 = EXCO EPSE1 GAXY NOID SCAL ;
  9262. EG2 = EXCO EPSE1 GAXZ NOID SCAL ;
  9263. EG3 = EXCO EPSE1 GAYZ NOID SCAL ;
  9264.  
  9265. TERM1 = (EX1 - EY1 ) ** 2 ;
  9266. TERM2 = (EY1 - EZ1 ) ** 2 ;
  9267. TERM3 = (EZ1 - EX1 ) ** 2 ;
  9268. TERM4 = 6. *( ((ABS (EG1/2.) ) ** 2.) + ((ABS (EG2/2.) ) ** 2.) + ((ABS (EG3/2.) ) ** 2.) );
  9269.  
  9270. EPS_ETOI = ((2. ** .5 )/3.) * ((TERM1 + TERM2 + TERM3 + TERM4 ) ** .5 );
  9271.  
  9272. * MIN1 = MINI EPS_ETOI ;
  9273. * MAX1 = MAXI EPS_ETOI ;
  9274.  
  9275. * RM 30/08/95 suppression du trace du champ
  9276. *
  9277. * SI (EGA MIN1 MAX1 1.E-6) ;
  9278. * MESS ' epsilon equivalent constant egal a ' MAX1;
  9279. * SINON ;
  9280. * TITR1 = CHAIN 'mini maxi epsilon equivalent : 'MIN1 MAX1;
  9281. * TITR TITR1 ;
  9282. * TRAC EPS_ETOI MOD1 (EXTR MOD1 'MAIL');
  9283. * FINSI ;
  9284. *
  9285. MESS '----------------------------> exiting @DEFO_EQ';
  9286. FINPROC EPS_ETOI;
  9287. **** @DEMATH1
  9288. DEBPROC @DEMATH1 TAB1*TABLE ;
  9289.  
  9290. MESS ' ';
  9291. NIVEAU = TAB1.'NIVEAU' ;
  9292. V1 = VALE DIME ;
  9293.  
  9294. * modification RMITTEAU le 6 juin 96 pour avoir les bonnes legendes
  9295. *dans les traces
  9296. * avec la version 96
  9297.  
  9298. SI (NIVEAU >EG 4) ;
  9299. MESS '---------------------------------> calling @DEMATH1';
  9300. FINSI ;
  9301.  
  9302. TACC1 = TABLE ;
  9303. TACC1.TITRE = TABLE ;
  9304. TAB1.DEF_MO = TABLE;
  9305. IC1 = 0 ;
  9306.  
  9307. SI ( EXISTE (TAB1.ZONE_MAT) 1 ) ;
  9308. MESS '>@DEMATH1> Materiau ----> 1 ';
  9309. MESS '>@DEMATH1> Definition of the conductivity of ' TAB1.NOM_MAT.1 ;
  9310. TITRE 'MATERIAL CONDUCTIVITY OR CAPACITY' ;
  9311. TAB1.'MAILLAG1' = TAB1. ZONE_MAT.1 ;
  9312. TAB1.'MAILLAGE' = TAB1. ZONE_MAT.1 ;
  9313.  
  9314. SI ( EXISTE (TAB1.NOM_MAT) 1.1 ) ;
  9315.  
  9316. MESS '>@DEMATH1> ' TAB1.NOM_MAT.1 ' est orthotrope';
  9317. SI ( NON ( EXISTE (TAB1.NOM_MAT) 1) ) ;
  9318. TAB1. NOM_MAT . 1 = TEXT '_ORTHOTROPE' ;
  9319. FINSI ;
  9320.  
  9321. TAB1.'EVOKX1' = @EVMAT (TAB1.NOM_MAT. 1.1) 'CONDUCTIVITE' TAB1 ;
  9322. TAB1.'EVOKY1' = @EVMAT (TAB1.NOM_MAT. 1.2) 'CONDUCTIVITE' TAB1 ;
  9323. TAB1.'EVOKZ1' = @EVMAT (TAB1.NOM_MAT. 1.3) 'CONDUCTIVITE' TAB1 ;
  9324.  
  9325. TAB1.'CONDUCT1' = @EVMAT (TAB1.NOM_MAT. 1.1) 'CONDUCTIVITE' TIN TAB1;
  9326. si (ega v1 2) ;
  9327. EVMA1 = ( TAB1.'EVOKX1') ET ( TAB1.'EVOKY1') ;
  9328. IC1 = IC1 + 1;
  9329. TACC1.IC1 = 'MARQ CARR ' ;
  9330. TACC1.TITRE.IC1 = TAB1.NOM_MAT.1.1 ;
  9331. IC1 = IC1 + 1 ;
  9332. TACC1.IC1 = 'MARQ TRIA ' ;
  9333. TACC1.TITRE.IC1 = TAB1.NOM_MAT.1.2 ;
  9334. sinon ;
  9335. EVMA1 = ( TAB1.'EVOKX1') ET ( TAB1.'EVOKY1') ET TAB1.'EVOKZ1' ;
  9336. IC1 = IC1 + 1;
  9337. TACC1.IC1 = 'MARQ CARR ' ;
  9338. TACC1.TITRE.IC1 = TAB1.NOM_MAT.1.1 ;
  9339. IC1 = IC1 + 1 ;
  9340. TACC1.IC1 = 'MARQ TRIA ' ;
  9341. TACC1.TITRE.IC1 = TAB1.NOM_MAT.1.2 ;
  9342. IC1 = IC1 + 1 ;
  9343. TACC1.IC1 = 'MARQ TRIA ' ;
  9344. TACC1.TITRE.IC1 = TAB1.NOM_MAT.1.3 ;
  9345.  
  9346. finsi ;
  9347. TAB1.DEF_MO.1 = MODE TAB1.ZONE_MAT.1 'THERMIQUE' 'ORTHOTROPE' ;
  9348.  
  9349. SINON ;
  9350. MESS '>@DEMATH1> ' TAB1.NOM_MAT.1 ' est isotrope';
  9351. TAB1.'EVOCON1' = @EVMAT (TAB1.NOM_MAT.1) 'CONDUCTIVITE' TAB1;
  9352. TAB1.'CONDUCT1' = @EVMAT (TAB1.NOM_MAT.1) 'CONDUCTIVITE' TIN TAB1;
  9353. TAB1.'EVOCOND' = @EVMAT (TAB1.NOM_MAT.1) 'CONDUCTIVITE' TAB1 ;
  9354. EVMA1 = TAB1.'EVOCON1' ;
  9355. TAB1.DEF_MO.1 = MODE TAB1.ZONE_MAT.1 'THERMIQUE' 'ISOTROPE' ;
  9356. IC1 = IC1 + 1 ;
  9357. TACC1.IC1 = 'MARQ TRIA ' ;
  9358. TACC1.TITRE.IC1 = TAB1.NOM_MAT.1;
  9359. MESS TACC1.IC1 ;
  9360. FINSI ;
  9361. SI ( TAB1.TRANSITOIRE ) ;
  9362. MESS '>@DEMATH1> Definition of the capacity of ' TAB1.NOM_MAT.1 ;
  9363. TAB1.'EVOCAPA' = @EVMAT (TAB1. NOM_MAT.1) 'CAPACITE' TAB1;
  9364. EVCA1 = TAB1.'EVOCAPA' ;
  9365. FINSI ;
  9366. FINSI ;
  9367. SI ( EXISTE (TAB1.ZONE_MAT) 2 ) ;
  9368. MESS '>@DEMATH1> Materiau ----> 2 ';
  9369. MESS '>@DEMATH1> Definition of the conductivity of ' TAB1.NOM_MAT.2 ;
  9370. TAB1.'MAILLAG2' = TAB1. ZONE_MAT.2 ;
  9371. * TAB1.'EVOCON2' = @EVMAT (TAB1. NOM_MAT.2) 'CONDUCTIVITE' TAB1 ;
  9372. * TAB1.'CONDUCT2' = @EVMAT (TAB1. NOM_MAT.2) 'CONDUCTIVITE' TIN TAB1 ;
  9373. * EVMA1 = EVMA1 ET ( TAB1.'EVOCON2') ;
  9374. * IC1 = IC1 + 1 ;
  9375. * TACC1.IC1 = ET 'MARQ CARR TITRE ' TAB1.NOM_MAT.2;
  9376. * TAB1.DEF_MO.2 = MODE TAB1.ZONE_MAT.2 'THERMIQUE' 'ISOTROPE' ;
  9377. *> js 050296
  9378. SI ( EXISTE (TAB1.NOM_MAT) 2.1 ) ;
  9379. MESS '>@DEMATH1> ' TAB1.NOM_MAT.2 ' est orthotrope';
  9380. SI ( NON ( EXISTE (TAB1.NOM_MAT) 2) ) ;
  9381. TAB1. NOM_MAT . 2 = TEXT '_ORTHOTROPE' ;
  9382. FINSI ;
  9383. TAB1.'EVOKX2' = @EVMAT (TAB1.NOM_MAT. 2.1) 'CONDUCTIVITE' TAB1 ;
  9384. TAB1.'EVOKY2' = @EVMAT (TAB1.NOM_MAT. 2.2) 'CONDUCTIVITE' TAB1 ;
  9385. TAB1.'EVOKZ2' = @EVMAT (TAB1.NOM_MAT. 2.3) 'CONDUCTIVITE' TAB1 ;
  9386. TAB1.'CONDUCT2' =@EVMAT (TAB1.NOM_MAT. 2.1) 'CONDUCTIVITE' TIN TAB1;
  9387. EVMA1 = EVMA1 ET ( TAB1.'EVOKX2') ET ( TAB1.'EVOKY2');
  9388. IC1 = IC1 + 1;
  9389. TACC1.IC1 = 'MARQ CROI ' ;
  9390. TACC1.TITRE.IC1 = (TAB1.NOM_MAT.2.1);
  9391. * MESS TACC1.IC1 ;
  9392. IC1 = IC1 + 1 ;
  9393. TACC1.IC1 = 'MARQ TRIA ' ;
  9394. TACC1.TITRE.IC1 = (TAB1.NOM_MAT.2.2);
  9395. * MESS TACC1.IC1 ;
  9396. TAB1.DEF_MO.2 = MODE TAB1.ZONE_MAT.2 'THERMIQUE' 'ORTHOTROPE' ;
  9397. SINON ;
  9398. TAB1.'EVOCON2' = @EVMAT (TAB1.NOM_MAT.2) 'CONDUCTIVITE' TAB1;
  9399. TAB1.'CONDUCT2' = @EVMAT (TAB1.NOM_MAT.2) 'CONDUCTIVITE' TIN TAB1;
  9400. TAB1.'EVOCON2' = @EVMAT (TAB1.NOM_MAT.2) 'CONDUCTIVITE' TAB1 ;
  9401. EVMA1 = EVMA1 ET TAB1.'EVOCON2' ;
  9402. TAB1.DEF_MO.2 = MODE TAB1.ZONE_MAT.2 'THERMIQUE' 'ISOTROPE' ;
  9403. IC1 = IC1 + 1 ;
  9404. TACC1.IC1 = 'MARQ TRIB ' ;
  9405. TACC1.TITRE.IC1 = (TAB1.NOM_MAT.2);
  9406. * MESS TACC1.IC1 ;
  9407. FINSI ;
  9408. *>
  9409. SI ( TAB1.TRANSITOIRE ) ;
  9410. MESS '>@DEMATH1> Definition of the capacity of ' TAB1.NOM_MAT.2 ;
  9411. TAB1.'EVOCAP2' = @EVMAT (TAB1. NOM_MAT.2) 'CAPACITE' TAB1 ;
  9412. EVCA1 = EVCA1 ET ( TAB1.'EVOCAP2') ;
  9413. FINSI ;
  9414. FINSI ;
  9415. SI ( EXISTE (TAB1.ZONE_MAT) 3 ) ;
  9416. MESS '>@DEMATH1> Materiau ----> 3 ';
  9417. MESS '>@DEMATH1> Definition of the conductivity of ' TAB1.NOM_MAT.3 ;
  9418. TAB1.'MAILLAG3' = TAB1. ZONE_MAT.3 ;
  9419. TAB1.'EVOCON3' = @EVMAT (TAB1. NOM_MAT.3) 'CONDUCTIVITE' TAB1 ;
  9420. TAB1.'CONDUCT3' = @EVMAT (TAB1. NOM_MAT.3) 'CONDUCTIVITE' TIN TAB1 ;
  9421. EVMA1 = EVMA1 ET ( TAB1.'EVOCON3') ;
  9422. IC1 = IC1 + 1 ;
  9423. TACC1.IC1 = 'MARQ ETOI ' ;
  9424. TACC1.TITRE.IC1=TAB1.NOM_MAT.3;
  9425. TAB1.DEF_MO.3 = MODE TAB1.ZONE_MAT.3 'THERMIQUE' 'ISOTROPE' ;
  9426. SI ( TAB1.TRANSITOIRE ) ;
  9427. MESS '>@DEMATH1> Definition of the capacity of ' TAB1.NOM_MAT.3 ;
  9428. TAB1.'EVOCAP3' = @EVMAT (TAB1. NOM_MAT.3) 'CAPACITE' TAB1 ;
  9429. EVCA1 = EVCA1 ET ( TAB1.'EVOCAP3') ;
  9430. FINSI ;
  9431. FINSI ;
  9432. SI ( EXISTE (TAB1.ZONE_MAT) 4 ) ;
  9433. MESS '>@DEMATH1> Material ----> 4 ';
  9434. MESS '>@DEMATH1> Definition of the conductivity of ' TAB1.NOM_MAT.4 ;
  9435. TAB1.'MAILLAG4' = TAB1. ZONE_MAT.4 ;
  9436. TAB1.'EVOCON4' = @EVMAT (TAB1. NOM_MAT.4) 'CONDUCTIVITE' TAB1 ;
  9437. TAB1.'CONDUCT4' = @EVMAT (TAB1. NOM_MAT.4) 'CONDUCTIVITE' TIN TAB1 ;
  9438. EVMA1 = EVMA1 ET ( TAB1.'EVOCON4') ;
  9439. IC1 = IC1 + 1 ;
  9440. TACC1.IC1 = 'MARQ LOSA ' ;
  9441. TACC1.TITRE.IC1 = TAB1.NOM_MAT.4 ;
  9442. TAB1.DEF_MO.4 = MODE TAB1.ZONE_MAT.4 'THERMIQUE' 'ISOTROPE' ;
  9443. SI ( TAB1.TRANSITOIRE ) ;
  9444. MESS '>@DEMATH1> Definition of the capacity of ' TAB1.NOM_MAT.4 ;
  9445. TAB1.'EVOCAP4' = @EVMAT (TAB1. NOM_MAT.4) 'CAPACITE' TAB1 ;
  9446. EVCA1 = EVCA1 ET ( TAB1.'EVOCAP4') ;
  9447. FINSI ;
  9448. FINSI ;
  9449. SI (NIVEAU >EG 4) ;
  9450. MESS '---------------------------------> exiting @DEMATH1';
  9451. FINSI ;
  9452. FINPROC EVMA1 EVCA1 TACC1 ;
  9453.  
  9454.  
  9455. **** @DEMATH2
  9456. DEBPROC @DEMATH2 TAB1*TABLE ;
  9457. TAB1.TABCON = TABLE ;
  9458. IPP1 = 0 ;
  9459. REPETER BOUCM7 ;
  9460. IPP1 = IPP1 + 1 ;
  9461. SI ( EXISTE (TAB1.ZONE_MAT) IPP1 ) ;
  9462. * MO_1 = MODE TAB1.ZONE_MAT.IPP1 'THERMIQUE' 'ISOTROPE';
  9463. MO_1 = TAB1.DEF_MO.IPP1 ;
  9464. TAB1.ZONE_MAT.IPP1 = EXTR 'MAIL' TAB1.DEF_MO.IPP1 ;
  9465. TAB1.TABCON.MO_1 =@EVMAT (TAB1.NOM_MAT.IPP1) 'CONDUCTIVITE' TAB1;
  9466. SINON ;
  9467. QUITTER BOUCM7 ;
  9468. FINSI ;
  9469. FIN BOUCM7 ;
  9470. FINPROC EVMA1 EVCA1 TACC1 ;
  9471.  
  9472.  
  9473. DEBPROC DEPOMIMA TAB1*TABLE ;
  9474. OPTION ECHO 1 IMPR 99 TRAC BENS ;
  9475. MOD_1 = TAB1.MODTOT ;
  9476. MAT_1 = TAB1.MATTOT ;
  9477. SI (EXISTE TAB1 L_ADEPOU ) ;
  9478. L_1 = TAB1.L_ADEPOU ;
  9479. FINSI ;
  9480. SI ( NON (EXISTE TAB1 MO_ADEPOU )) ;
  9481. MOTOT1 = MOD_1 ;
  9482. SINON ;
  9483. MOTOT1 = TAB1.MO_ADEPOU ;
  9484. FINSI ;
  9485. N_MAIL = EXTR 'MAIL' MOTOT1 ;
  9486. *SI ( NON (EXISTE TAB1 NMAIL_ADEPOU )) ;
  9487. * N_MAIL = 'MAIL TOT' ;
  9488. *SINON ;
  9489. * N_MAIL = TAB1.NMAIL_ADEPOU ;
  9490. *FINSI ;
  9491. I1 = 0 ;
  9492. MESS ' >>>>>>>> ' N_MAIL ' :' ;
  9493. MESS ' ====================================' ;
  9494. SAUT 2 LIGNE ;
  9495. MESS '******************************' ;
  9496. MESS '*** CONTRAINTES **' ;
  9497. MESS '******************************' ;
  9498. REPETER BDEPO1 ( DIME TAB1.L_CASADEPOU ) ;
  9499. I1 = I1 + 1 ;
  9500. XIT1 = EXTR I1 TAB1.L_CASADEPOU ;
  9501. VMI1 = VMIS MOD_1 TAB1.RESUCONT.XIT1 ;
  9502. SIRESU1 = TAB1.RESUCONT.XIT1 ET VMI1 ;
  9503. SIRESUA = TAB1.RESUVARI.XIT1 ET VMI1 ;
  9504. I2 = 0 ;
  9505. SAUT 2 LIGNE ;
  9506. MESS 'TIME' XIT1 ;
  9507. SAUT LIGNE ;
  9508. MESS ' MINI * MAXI';
  9509. SAUT LIGNE ;
  9510. REPETER BDEPO2 ( DIME TAB1.LM_SIGCOMP) ;
  9511. I2 = I2 + 1 ;
  9512. MOCOMP = EXTR TAB1.LM_SIGCOMP I2 ;
  9513. TMOCOMP = TEXT MOCOMP ;
  9514. SI (( EGA MOCOMP 'VMIS') OU ( EGA MOCOMP 'VONM') ) ;
  9515. MOCOMP = 'SCAL' ;
  9516. FINSI ;
  9517. SBID1 = REDU ( EXCO SIRESU1 MOCOMP ) MOTOT1 ;
  9518. MAXSB1 = ((MAXI SBID1)/1.E6) ;
  9519. MINSB1 = ((MINI SBID1)/1.E6) ;
  9520. MESS TMOCOMP ' (MPa) : ' MINSB1 ' * ' MAXSB1 ;
  9521. FIN BDEPO2 ;
  9522. SI (EXISTE TAB1 L_ADEPOU ) ;
  9523. DEPOULI L_1 'CONTRAINTES' MOD_1 TAB1.RESUCONT.XIT1 GLOBAL MASSIF ;
  9524. FINSI ;
  9525. FIN BDEPO1 ;
  9526. I3 = 0 ;
  9527. SAUT 2 LIGNE ;
  9528. MESS '******************************' ;
  9529. MESS '*** DEFORMATIONS **' ;
  9530. MESS '******************************' ;
  9531. SAUT 2 LIGNE ;
  9532. REPETER BDEPO3 ( DIME TAB1.L_CASADEPOU ) ;
  9533. I3 = I3 + 1 ;
  9534. XIT1 = EXTR I3 TAB1.L_CASADEPOU ;
  9535. DEPL_1 = TAB1.RESUDEPL.XIT1 ;
  9536. SI_1 = TAB1.RESUCONT.XIT1 ;
  9537. EPS_0 = EPSI MOD_1 DEPL_1 ;
  9538. EPS_1 = EPS_0 ET ( EXCO EPSE TAB1.RESUVARI.XIT1) ;
  9539. I4 = 0 ;
  9540. SAUT 2 LIGNE ;
  9541. MESS 'TIME' XIT1 ;
  9542. SAUT LIGNE ;
  9543. MESS ' MINI * MAXI DU MCHAM PTS GAUSS';
  9544. SAUT LIGNE ;
  9545. REPETER BDEPO4 ( DIME TAB1.LM_EPSCOMP) ;
  9546. I4 = I4 + 1 ;
  9547. MOCOMP = EXTR TAB1.LM_EPSCOMP I4 ;
  9548. TMOCOMP = TEXT MOCOMP ;
  9549. SI (( EGA MOCOMP 'EPZZ' ) ET ( EGA (VALE MODE) 'PLANCONT')) ;
  9550. EPS_2 = TAB1.RESUDEFI.XIT1 + (EPSCHL MOD_1 SI_1 (TAB1.CHPOTHETA. 0.) (TAB1.CHPOTHETA.XIT1) TAB1 ) ;
  9551. EPSB2 = REDU ( EXCO EPS_2 MOCOMP ) MOTOT1 ;
  9552. MAXEB2 = ((MAXI EPSB2) * 1.E2) ;
  9553. MINEB2 = ((MINI EPSB2) * 1.E2) ;
  9554. MESS TMOCOMP ' ( % ) : ' MINEB2 ' * ' MAXEB2 ;
  9555. SINON ;
  9556. EPSB1 = REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 ;
  9557. MAXEB1 = ((MAXI EPSB1) * 1.E2) ;
  9558. MINEB1 = ((MINI EPSB1) * 1.E2) ;
  9559. MESS TMOCOMP ' ( % ) : ' MINEB1 ' * ' MAXEB1 ;
  9560. FINSI ;
  9561. FIN BDEPO4 ;
  9562. SI (EXISTE TAB1 L_ADEPOU ) ;
  9563. DEPOULI L_1 'DEFORMATIONS' MOD_1 EPS_0 GLOBAL MASSIF ;
  9564. FINSI ;
  9565. FIN BDEPO3 ;
  9566. SAUT PAGE ;
  9567. OPTI ECHO 1 IMPR 6;
  9568. FINPROC ;
  9569. *****************************************************************
  9570. * *
  9571. * Procedure DEPOULI : trace des contraintes ou des deformations *
  9572. * le long d'un ligne quelconque *
  9573. * *
  9574. *****************************************************************
  9575. 'DEBPROC' FRENETT LIGN_1*MAILLAGE ;
  9576. MESS '----------------------> entree dans FRENETT ';
  9577. V1 = VALEUR DIME ;
  9578. SI( V1 EGA 2 ) ;
  9579. CHT CHN CHB = FRENET LIGN_1 'TRACE' ;
  9580. CHPP = CHT ET CHN ;
  9581. SINON ;
  9582. CHT CHN CHB = FRENET LIGN_1 'TRACE' (0. 0. 1000.);
  9583. CHPP = CHT ET CHN ET CHB ;
  9584. FINSI ;
  9585. MESS '----------------------> sortie de FRENETT ';
  9586. 'FINPROC' CHPP;
  9587.  
  9588.  
  9589.  
  9590. 'DEBPROC' DEPOULI LIGN_1*MAILLAGE M_IND1*MOT MOD_L*MMODEL MCHA_E2*MCHAML M_REP2*MOT M_ELEM*MOT VECT1/POINT VECT2/POINT MCHA_E3/MCHAML ;
  9591.  
  9592. MESS '----------------------> entree dans DEPOULI';
  9593.  
  9594. TAB1 = TABLE;
  9595. TAC1 = TABLE ;
  9596.  
  9597. SI (( NON (EGA M_ELEM 'MASSIF')) ET (NON (EGA M_ELEM 'INFE')) ET (NON (EGA M_ELEM 'MOYE')) ET (NON (EGA M_ELEM 'SUPE')));
  9598. MESS '>>>DEPOULI>>>> OPTION NON PREVU :' M_ELEM ;
  9599. MESS '>>>DEPOULI>>>> ON STOPPE ICI ....' ;
  9600. ERREUR 'MAUVAIS_INDIC_ELEMENT_DANS_DEPOULI';
  9601. FINSI ;
  9602.  
  9603.  
  9604. SI (( NON (EGA M_REP2 'FIXE')) ET (NON (EGA M_REP2 'GLOBAL')) ET (NON (EGA M_REP2 'LOCAL')));
  9605. MESS '>>>DEPOULI>>>> OPTION NON PREVU :' M_REP2 ;
  9606. MESS '>>>DEPOULI>>>> ON STOPPE ICI ....' ;
  9607. ERREUR 'MAUVAIS_INDIC_REPERE_DANS_DEPOULI';
  9608. SINON;
  9609. M_REPE = M_REP2 ;
  9610. FINSI ;
  9611.  
  9612.  
  9613. SI (( NON (EGA M_IND1 'CONTRAINTES')) ET ( NON (EGA M_IND1 'DEFORMATIONS')) );
  9614. MESS '>>>DEPOULI>>>> OPTION NON PREVU :' M_IND1 ;
  9615. MESS '>>>DEPOULI>>>> ON STOPPE ICI ....' ;
  9616. ERREUR 'MAUVAIS_INDIC_DANS_DEPOULI';
  9617. FINSI ;
  9618.  
  9619. LCONFON = FAUX ;
  9620. MAIL_1 = MOD_L EXTR 'MAIL';
  9621. N_1 = NBNO MAIL_1 ;
  9622. N_2 = NBNO (MAIL_1 ET LIGN_1 );
  9623.  
  9624. SI ( EGA N_1 N_2 ) ;
  9625. LCONFON = VRAI;
  9626. FINSI ;
  9627.  
  9628. SI (EXISTE MCHA_E3);
  9629. SI (EGA M_IND1 'CONTRAINTES');
  9630. CAR1 = MCHA_E3;
  9631. FINSI ;
  9632. SI (EGA M_IND1 'DEFORMATIONS');
  9633. MCHA_EP = MCHA_E3;
  9634. FINSI ;
  9635. FINSI;
  9636.  
  9637.  
  9638. SI (EGA M_IND1 'CONTRAINTES');
  9639. MO_TI1 = MOT 'STRESSES ALONG THE LINE ' ;
  9640. FINSI ;
  9641. SI (EGA M_IND1 'DEFORMATIONS');
  9642. MO_TI1 = MOT 'STRAINS ALONG THE LINE ' ;
  9643. FINSI ;
  9644.  
  9645. SI (EGA M_REPE 'FIXE');
  9646. MO_TI2 = MOT ' (REPERE FIXE DONNE)';
  9647. SINON;
  9648. SI (EGA M_REPE 'GLOBAL');
  9649. MO_TI2 = MOT ' (REPERE GLOBAL)';
  9650. SINON;
  9651. MO_TI2 = MOT ' (REPERE LOCAL DE FRENET)';
  9652. FINSI;
  9653. FINSI;
  9654.  
  9655.  
  9656. SI(NON (EXISTE L_COQ2 ));
  9657. L_COQ1 = FAUX ;
  9658. SINON ;
  9659. L_COQ1 = L_COQ2 ;
  9660. FINSI;
  9661.  
  9662.  
  9663. SI (EGA M_REPE 'FIXE');
  9664. SI ((VALEUR DIME) EGA 3);
  9665. MCHA_E11 = RTENS MCHA_E2 MOD_L VECT1 VECT2;
  9666. MCHA_E1 = MCHA_E11;
  9667. SINON;
  9668. TYP1 = TYPE MCHA_E2; MESS TYP1;
  9669. MCHA_E11 = RTENS MCHA_E2 MOD_L VECT1;
  9670. MCHA_E1 = MCHA_E11;
  9671. FINSI;
  9672. SINON;
  9673. MCHA_E1 = MCHA_E2;
  9674. FINSI;
  9675.  
  9676.  
  9677. ***CHTT1 CHPOINT sur la ligne
  9678. ***EV_OTT evolution globale
  9679.  
  9680. CHM1 = REDU MCHA_E1 MOD_L ;
  9681. TC1 = EXTR CHM1 'COMP' ;
  9682. LIST1 = MOTS CROI TRIA PLUS LOSA CARR TRIB ETOI TRIB CARR LOSA;
  9683.  
  9684.  
  9685. SI ( (EGA M_REPE 'FIXE') OU (EGA M_REPE 'GLOBAL') );
  9686.  
  9687. SI (EGA M_IND1 'CONTRAINTES');
  9688. SI (EGA (VALEUR DIME) 2);
  9689. LIST2 = MOTS SMXX SMYY SMZZ SMXY VMIS TRES TREI TREE ;
  9690. SINON;
  9691. LIST2 = MOTS SMXX SMYY SMZZ SMXY SMXZ SMYZ VMIS TRES TREI TREE;
  9692. FINSI;
  9693. SINON;
  9694. SI (EGA (VALEUR DIME) 2);
  9695. LIST2 = MOTS EPXX EPYY EPZZ GAXY PLAS;
  9696. SINON;
  9697. LIST2 = MOTS EPXX EPYY EPZZ GAXY GAXZ GAYZ PLAS;
  9698. FINSI;
  9699. FINSI;
  9700.  
  9701. I1 = 1;
  9702. REPETER BOUC1 (DIME TC1 );
  9703. MOC1 = ( EXTR TC1 I1 );
  9704. SSI1 = EXCO MOC1 CHM1 'SCAL';
  9705. SI LCONFON;
  9706. CHI1 = CHAN 'CHPO' MOD_L ( CHAN NOEUD MOD_L SSI1 );
  9707. SINON ;
  9708. CHI1 = PROI LIGN_1 ( CHAN NOEUD MOD_L SSI1 );
  9709. FINSI;
  9710. CHI1 = NOMC MOC1 CHI1;
  9711. EV_I1 = EVOL CHPO CHI1 MOC1 LIGN_1;
  9712. TAB1.MOC1 = EV_I1;
  9713. TITRE MO_TI1 MO_TI2;
  9714. SI ( I1 EGA 1 );
  9715. MARQ1 = TEXT (EXTR 1 LIST1);
  9716. COMP1 = TEXT (EXTR 1 LIST2);
  9717. * TAC1.1 = CHAINE ' MARQ ' MARQ1 ' REGU ' ' TITR ' COMP1;
  9718. EV_OTT = EV_I1;
  9719. CHTT1 = CHI1;
  9720. SINON ;
  9721. DIM1 = DIME EV_OTT;
  9722. MARQ1 = TEXT (EXTR I1 LIST1);
  9723. COMP1 = TEXT (EXTR I1 LIST2);
  9724. * TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU ' ' TITR ' COMP1;
  9725. EV_OTT = EV_OTT ET EV_I1 ;
  9726. CHTT1 = CHTT1 ET CHI1;
  9727. FINSI ;
  9728. I1 = I1 + 1;
  9729. FIN BOUC1;
  9730. FINSI ;
  9731.  
  9732. SI (EGA M_REPE 'LOCAL');
  9733. SI (EGA M_IND1 'CONTRAINTES');
  9734. SI (EGA (VALEUR DIME) 2);
  9735. LIST2 = MOTS SMTT SMNN SMBB SMTN VMIS TRES TREI TREE;
  9736. SINON;
  9737. LIST2 = MOTS SMTT SMNN SMBB SMTN SMTB SMNB VMIS TRES TREI TREE;
  9738. FINSI;
  9739. SINON;
  9740. SI (EGA (VALEUR DIME) 2);
  9741. LIST2 = MOTS EPTT EPNN EPBB GATN PLAS;
  9742. SINON;
  9743. LIST2 = MOTS EPTT EPNN EPBB GATN GATB GANB PLAS;
  9744. FINSI;
  9745. FINSI;
  9746. I1 = 1;
  9747.  
  9748. REPETER BOUC3 (DIME TC1 );
  9749. MOC1 = ( EXTR TC1 I1 );
  9750. SSI1 = EXCO MOC1 CHM1 'SCAL';
  9751. SI LCONFON;
  9752. CHI1 = CHAN 'CHPO' MOD_L ( CHAN NOEUD MOD_L SSI1 );
  9753. SINON ;
  9754. CHI1 = PROI LIGN_1 ( CHAN NOEUD MOD_L SSI1 );
  9755. FINSI;
  9756. CHI1 = NOMC MOC1 CHI1;
  9757. TAB1.MOC1 = EV_I1;
  9758. SI ( I1 EGA 1 );
  9759. CHTT1 = CHI1;
  9760. SINON ;
  9761. CHTT1 = CHTT1 ET CHI1;
  9762. FINSI ;
  9763. I1 = I1 + 1;
  9764. FIN BOUC3;
  9765. CHPP = FRENETT LIGN_1 ;
  9766. CHTT2 = CHREP M_IND1 CHTT1 CHPP ;
  9767. TC1 = EXTR CHTT2 'COMP' ;
  9768. MENAGE ;
  9769. I1 = 1 ;
  9770. REPETER BOUC2 (DIME TC1 ) ;
  9771. MOC1 = ( EXTR TC1 I1 ) ;
  9772. EV_I1 = EVOL CHPO CHTT2 MOC1 LIGN_1 ;
  9773. TITRE MO_TI1 MO_TI2 ;
  9774. MENAGE ;
  9775. SI ( I1 EGA 1 ) ;
  9776. MARQ1 = TEXT (EXTR 1 LIST1) ;
  9777. COMP1 = TEXT (EXTR 1 LIST2) ;
  9778. * TAC1.1 = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  9779. EV_OTT = EV_I1;
  9780. SINON;
  9781. DIM1 = DIME EV_OTT;
  9782. MARQ1 = TEXT (EXTR I1 LIST1);
  9783. COMP1 = TEXT (EXTR I1 LIST2);
  9784. * TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  9785. EV_OTT = EV_OTT ET EV_I1;
  9786. FINSI;
  9787. I1 = I1 + 1;
  9788. TAB1.MOC1 = EV_I1;
  9789. FIN BOUC2;
  9790. FINSI;
  9791.  
  9792. SI (EGA M_IND1 'CONTRAINTES');
  9793.  
  9794. SI ((EGA M_ELEM 'MASSIF') OU (EGA M_ELEM 'MOYE'));
  9795.  
  9796. DIM1 = DIME EV_OTT;
  9797. MARQ1 = TEXT (EXTR I1 LIST1);
  9798. COMP1 = TEXT (EXTR I1 LIST2);
  9799. * TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  9800. I1 = I1 + 1;
  9801.  
  9802. SI (EXISTE MCHA_E3);
  9803. VMI1 = VMIS MOD_L CHM1 CAR1;
  9804. SINON ;
  9805. VMI1 = VMIS MOD_L CHM1 ;
  9806. FINSI;
  9807. SI LCONFON;
  9808. CHVM = CHAN 'CHPO' MOD_L ( CHAN NOEUD MOD_L VMI1 );
  9809. SINON ;
  9810. CHVM = PROI LIGN_1 ( CHAN NOEUD MOD_L VMI1 );
  9811. FINSI;
  9812. EVVM = EVOL ROUGE CHPO CHVM SCAL LIGN_1;
  9813. EV_OTT = EV_OTT ET EVVM ;
  9814. TAB1.VMIS = EVVM;
  9815.  
  9816. DIM1 = DIME EV_OTT;
  9817. MARQ1 = TEXT (EXTR I1 LIST1);
  9818. COMP1 = TEXT (EXTR I1 LIST2);
  9819. * TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  9820. I1 = I1 + 1;
  9821.  
  9822. SI (EXISTE MCHA_E3);
  9823. TRE1 = TRESCA MOD_L CHM1 CAR1 MOYE;
  9824. SINON ;
  9825. SI (EGA M_ELEM 'MASSIF');
  9826. TRE1 = TRESCA MOD_L CHM1 ;
  9827. SINON ;
  9828. TRE1 = TRESCA MOD_L CHM1 MOYE;
  9829. FINSI ;
  9830. FINSI;
  9831. SI LCONFON;
  9832. CHTR1 = CHAN 'CHPO' MOD_L ( CHAN NOEUD MOD_L TRE1 );
  9833. SINON ;
  9834. CHTR1 = PROI LIGN_1 ( CHAN NOEUD MOD_L TRE1 );
  9835. FINSI;
  9836. EVTR1 = EVOL VERT CHPO CHTR1 SCAL LIGN_1;
  9837. EV_OTT = EV_OTT ET EVTR1 ;
  9838. TAB1.TRES1 = EVTR1;
  9839.  
  9840. FINSI;
  9841.  
  9842.  
  9843. SI (EGA M_ELEM 'MOYE') ;
  9844.  
  9845. DIM1 = DIME EV_OTT;
  9846. MARQ1 = TEXT (EXTR I1 LIST1);
  9847. COMP1 = TEXT (EXTR I1 LIST2);
  9848. * TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  9849. I1 = I1 + 1;
  9850.  
  9851. TRE2 = TRESCA MOD_L CHM1 CAR1 INFE;
  9852. SI LCONFON;
  9853. CHTR2 = CHAN 'CHPO' MOD_L ( CHAN NOEUD MOD_L TRE2);
  9854. SINON ;
  9855. CHTR2 = PROI LIGN_1 ( CHAN NOEUD MOD_L TRE2 );
  9856. FINSI;
  9857. EVTR2 = EVOL ROUGE CHPO CHTR2 SCAL LIGN_1;
  9858. EV_OTT = EV_OTT ET EVTR2 ;
  9859. TAB1.TRES2 = EVTR2;
  9860.  
  9861.  
  9862. DIM1 = DIME EV_OTT;
  9863. MARQ1 = TEXT (EXTR I1 LIST1);
  9864. COMP1 = TEXT (EXTR I1 LIST2);
  9865. * TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  9866.  
  9867. TRE3 = TRESCA MOD_L CHM1 CAR1 SUPE;
  9868. SI LCONFON;
  9869. CHTR3 = CHAN 'CHPO' MOD_L (CHAN NOEUD MOD_L TRE3 );
  9870. SINON ;
  9871. CHTR3 = PROI LIGN_1 (CHAN NOEUD MOD_L TRE3 );
  9872. FINSI;
  9873. EVTR3 = EVOL ROSE CHPO CHTR3 SCAL LIGN_1;
  9874. EV_OTT = EV_OTT ET EVTR3 ;
  9875. TAB1.TRES = EVTR3;
  9876.  
  9877. FINSI;
  9878. FINSI;
  9879.  
  9880. SI (EGA M_IND1 'DEFORMATIONS');
  9881. SI ( EXISTE MCHA_E3 );
  9882. * I2 = I1 * 2 - 1;
  9883. * TAC1.I2 = 'MARQ ETOI TITR EPSE_PLAS';
  9884. EPSE1 = EXCO EPSE (REDU MCHA_EP MOD_L) ;
  9885. SI LCONFON;
  9886. EPSEL1 = CHAN 'CHPO' MOD_L (CHAN NOEUD MOD_L EPSE1) ;
  9887. SINON ;
  9888. EPSEL1 = PROI LIGN_1 (CHAN NOEUD MOD_L EPSE1) ;
  9889. FINSI;
  9890. EVOSE = EVOL ROUGE CHPO EPSEL1 EPSE LIGN_1 ;
  9891.  
  9892. DIM1 = DIME EV_OTT;
  9893. MARQ1 = TEXT (EXTR I1 LIST1);
  9894. COMP1 = TEXT (EXTR I1 LIST2);
  9895. * TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  9896. EV_OTT = EV_OTT ET EVOSE ;
  9897. TAB1.PLAS = EVOSE;
  9898. FINSI;
  9899. FINSI;
  9900.  
  9901.  
  9902. DESS EV_OTT TAC1 MIMA LEGE ;
  9903.  
  9904. TAB1.MARC = TAC1;
  9905. TAB1.EVOL = EV_OTT;
  9906.  
  9907. MESS '----------------------> sortie de DEPOULI ';
  9908. FINPROC TAB1;
  9909.  
  9910.  
  9911.  
  9912.  
  9913.  
  9914.  
  9915.  
  9916.  
  9917.  
  9918.  
  9919.  
  9920.  
  9921.  
  9922.  
  9923.  
  9924.  
  9925.  
  9926.  
  9927.  
  9928.  
  9929.  
  9930. 'DEBPROC' DEPT LIGN_1*MAILLAGE MOD_L*MMODEL MCHA_E2*CHPOINT;
  9931.  
  9932. MESS '----------------------> entree dans DEPT';
  9933.  
  9934. LCONFON = FAUX ;
  9935. MAIL_1 = MOD_L EXTR 'MAIL';
  9936. N_1 = NBNO MAIL_1 ;
  9937. N_2 = NBNO (MAIL_1 ET LIGN_1 );
  9938.  
  9939. SI ( EGA N_1 N_2 ) ;
  9940. LCONFON = VRAI;
  9941. FINSI ;
  9942.  
  9943. MAIL1 = (extr MOD_L 'MAIL' ) ;
  9944. LEV1 = REDU MCHA_E2 MAIL1;
  9945.  
  9946. SI LCONFON ;
  9947. LEV2 = REDU LEV1 LIGN_1 ;
  9948. LEV3 = EVOL CHPO LEV2 LIGN_1 ;
  9949. SINON ;
  9950. LEV2 = PROI (CHAN CHAM LEV1 MAIL1 NOEUD ) LIGN_1 ;
  9951. LEV3 = EVOL CHPO LEV2 LIGN_1 ;
  9952. FINSI ;
  9953.  
  9954. DESS LEV3 ;
  9955.  
  9956.  
  9957.  
  9958.  
  9959. MESS '----------------------> sortie de DEPT ';
  9960. FINPROC ;
  9961.  
  9962.  
  9963.  
  9964.  
  9965.  
  9966.  
  9967.  
  9968.  
  9969.  
  9970.  
  9971.  
  9972.  
  9973.  
  9974.  
  9975.  
  9976.  
  9977.  
  9978.  
  9979.  
  9980.  
  9981.  
  9982. **** @DESCEND
  9983.  
  9984. DEBPROC @DESCEND CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT PASB0*FLOTTANT CHSIGN0*CHPOINT TAB1*TABLE ;
  9985. *
  9986. *****************************************************
  9987. * Procedure de descente des lignes de champ par une *
  9988. * methode explicite. Alain MOAL (Fevrier 2001) *
  9989. *****************************************************
  9990. *
  9991. *MESS '---------------------------------> calling @descend';
  9992. *
  9993. *--------------- VARIABLES D'ENTREE :
  9994. MAIL0 = TAB1.<MAILLAGE_B ;
  9995. *-----------------------------------
  9996. *
  9997. *---- Calcul du champ et de sa norme
  9998. BR BZ BPHI = @MAGNB TAB1 ;
  9999. *
  10000. *---- Descente dans le plan (R,Z)
  10001. BPHI = BPHI * 0. ;
  10002. PHI = ATG (COOR 2 MAIL0) (COOR 1 MAIL0) ;
  10003. *AM*11/09/01*BX = BR * (COS PHI) + (BPHI * (SIN PHI));
  10004. *AM*11/09/01*BY = BR * (SIN PHI) - (BPHI * (COS PHI));
  10005. BX = BR * (COS PHI) - (BPHI * (SIN PHI));
  10006. BY = BR * (SIN PHI) + (BPHI * (COS PHI));
  10007. NORM_B = ((BX*BX) + (BY*BY) + (BZ*BZ))**0.5 ;
  10008. *
  10009. *---- Deplacements (methode explicite) affectes du signe
  10010. *---- donnant le sens de descente dans le plan (R,Z)
  10011. DEPX0 = CHSIGN0 * BX * PASB0 / NORM_B ;
  10012. DEPY0 = CHSIGN0 * BY * PASB0 / NORM_B ;
  10013. DEPZ0 = CHSIGN0 * BZ * PASB0 / NORM_B ;
  10014. *
  10015. *---- Nouvelles coordonnees
  10016. X_NEW = CHP_X + DEPX0 ;
  10017. Y_NEW = CHP_Y + DEPY0 ;
  10018. Z_NEW = CHP_Z + DEPZ0 ;
  10019. *
  10020. *---- actualisation de la position des points de la ligne
  10021. DEPX0 = NOMC UX DEPX0 NATURE DIFFUS ;
  10022. DEPY0 = NOMC UY DEPY0 NATURE DIFFUS ;
  10023. DEPZ0 = NOMC UZ DEPZ0 NATURE DIFFUS ;
  10024. DEP0 = DEPX0 ET DEPY0 ET DEPZ0 ;
  10025. *
  10026. *MESS '---------------------------------> exiting @descend';
  10027. FINPROC X_NEW Y_NEW Z_NEW DEP0 ;
  10028.  
  10029. **** @DEXPJET
  10030.  
  10031. DEBPROC @DEXPJET CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT PASB0*FLOTTANT TAB1*TABLE;
  10032.  
  10033. *MESS '---------------------------------> calling @DEXPJET';
  10034. *
  10035. *--------------- VARIABLES D'ENTREE :
  10036. MAIL0 = TAB1.<MAILLAGE_B ;
  10037. *-----------------------------------
  10038. *
  10039. *---- Calcul du champ et de sa norme
  10040. BR BZ BPHI = @MAGNB TAB1 ;
  10041. *
  10042. PHI = ATG (COOR 2 MAIL0) (COOR 1 MAIL0) ;
  10043. *AM*11/09/01*BX = BR * (COS PHI) + (BPHI * (SIN PHI));
  10044. *AM*11/09/01*BY = BR * (SIN PHI) - (BPHI * (COS PHI));
  10045. BX = BR * (COS PHI) - (BPHI * (SIN PHI));
  10046. BY = BR * (SIN PHI) + (BPHI * (COS PHI));
  10047. NORM_B = ((BX*BX) + (BY*BY) + (BZ*BZ))**0.5 ;
  10048. *
  10049. *---- Deplacements (methode explicite)
  10050. DEPX0 = BX * PASB0 / NORM_B ;
  10051. DEPY0 = BY * PASB0 / NORM_B ;
  10052. DEPZ0 = BZ * PASB0 / NORM_B ;
  10053.  
  10054. *MESS '---------------------------------> exiting @DEXPJET';
  10055. FINPROC DEPX0 DEPY0 DEPZ0 ;
  10056.  
  10057. **** @DEXPLI
  10058.  
  10059. DEBPROC @DEXPLI CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT PASB0*FLOTTANT TAB1*TABLE;
  10060.  
  10061. *MESS '---------------------------------> calling @DEXPLI';
  10062.  
  10063. *--------------- VARIABLES D'ENTREE :
  10064. TYPCAL = TAB1.<TYPE_CALCUL ;
  10065. *------------------------------------
  10066. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  10067. ISHIFT = VRAI ;
  10068. IRIPPLE = VRAI ;
  10069. FINSI ;
  10070. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  10071. ISHIFT = VRAI ;
  10072. IRIPPLE = FAUX ;
  10073. FINSI ;
  10074. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  10075. ISHIFT = FAUX ;
  10076. IRIPPLE = VRAI ;
  10077. FINSI ;
  10078. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  10079. ISHIFT = FAUX ;
  10080. IRIPPLE = FAUX ;
  10081. FINSI ;
  10082. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  10083. ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
  10084. FINSI ;
  10085.  
  10086. * ---- Calcul du champ dans le repere global
  10087. BXG BYG BZG FSECU = @CHAMB TAB1 CHP_X CHP_Y CHP_Z ISHIFT IRIPPLE ;
  10088.  
  10089. * ---- Calcul de la norme du champ
  10090.  
  10091. NORM_B = ((BXG*BXG) + (BYG*BYG) + (BZG*BZG))**0.5 ;
  10092.  
  10093. * ---- Calcul des deplacements
  10094.  
  10095. DEPX0 = BXG * PASB0 / NORM_B ;
  10096. DEPY0 = BYG * PASB0 / NORM_B ;
  10097. DEPZ0 = BZG * PASB0 / NORM_B ;
  10098.  
  10099. *MESS '---------------------------------> exiting @DEXPLI';
  10100. FINPROC DEPX0 DEPY0 DEPZ0 ;
  10101. **** @DMILIEU
  10102.  
  10103. DEBPROC @DMILIEU CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT PASB0*FLOTTANT CHSIGN/CHPOINT TAB1*TABLE;
  10104.  
  10105. *MESS '---------------------------------> calling @DMILIEU';
  10106.  
  10107. *--------------- VARIABLES D'ENTREE :
  10108. TYPCAL = TAB1.<TYPE_CALCUL ;
  10109. RP = TAB1.<RP ;
  10110. HP = TAB1.<HP ;
  10111. *------------------------------------
  10112. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  10113. ISHIFT = VRAI ;
  10114. IRIPPLE = VRAI ;
  10115. FINSI ;
  10116. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  10117. ISHIFT = VRAI ;
  10118. IRIPPLE = FAUX ;
  10119. FINSI ;
  10120. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  10121. ISHIFT = FAUX ;
  10122. IRIPPLE = VRAI ;
  10123. FINSI ;
  10124. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  10125. ISHIFT = FAUX ;
  10126. IRIPPLE = FAUX ;
  10127. FINSI ;
  10128. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  10129. ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
  10130. FINSI ;
  10131. *
  10132. SI (EGA (TYPE CHSIGN) MOT) ;
  10133. * --- Cas ou l'appel vient d'une proc qui n'a pas calcule CHSIGN
  10134. CHSIGN = 1. ;
  10135. FINSI ;
  10136. *BR01/10/98 SI (EXISTE TAB1 <CHSIGN) ;
  10137. * CHSIGN = TAB1.<CHSIGN ;
  10138. * --- Cas ou l'appel vient d'une proc qui n'a pas calcule TAB1.<CHSIGN
  10139. *SINON ;
  10140. * CHSIGN = 1. ;
  10141. *FINSI ;
  10142.  
  10143. * ---- Lors du premier pas, calcul des points milieux
  10144. SI (NON (EXIS TAB1 <CHP_X1)) ;
  10145.  
  10146.  
  10147. DEPX0 DEPY0 DEPZ0 = @DEXPLI CHP_X CHP_Y CHP_Z PASB0 TAB1;
  10148. CHP_X1 = CHP_X + (CHSIGN * DEPX0) ;
  10149. CHP_Y1 = CHP_Y + (CHSIGN * DEPY0) ;
  10150. CHP_Z1 = CHP_Z + (CHSIGN * DEPZ0) ;
  10151. SINON ;
  10152. CHP_X1 = TAB1.<CHP_X1 ;
  10153. CHP_Y1 = TAB1.<CHP_Y1 ;
  10154. CHP_Z1 = TAB1.<CHP_Z1 ;
  10155. MAILR = EXTR CHP_X MAIL ;
  10156. CHP_X1 = REDU CHP_X1 MAILR ;
  10157. CHP_Y1 = REDU CHP_Y1 MAILR ;
  10158. CHP_Z1 = REDU CHP_Z1 MAILR ;
  10159. FINSI ;
  10160.  
  10161. * ---- Calcul du deplacement dans le repere global
  10162. * ---- (aux points milieux)
  10163.  
  10164. DEPX0 DEPY0 DEPZ0 = @DEXPLI CHP_X1 CHP_Y1 CHP_Z1 PASB0 TAB1 ;
  10165.  
  10166. * ---- Actualisation des points initiaux
  10167.  
  10168. X_NEW = CHP_X + (CHSIGN * DEPX0) ;
  10169. Y_NEW = CHP_Y + (CHSIGN * DEPY0) ;
  10170. Z_NEW = CHP_Z + (CHSIGN * DEPZ0) ;
  10171.  
  10172.  
  10173. * ---- Calcul du deplacement aux points initiaux remontes
  10174.  
  10175.  
  10176. DEPXI DEPYI DEPZI = @DEXPLI X_NEW Y_NEW Z_NEW PASB0 TAB1;
  10177.  
  10178. * ---- Calcul des nouveaux points milieux
  10179.  
  10180. CHP_X1 = CHP_X1 + (CHSIGN * DEPXI) ;
  10181. CHP_Y1 = CHP_Y1 + (CHSIGN * DEPYI) ;
  10182. CHP_Z1 = CHP_Z1 + (CHSIGN * DEPZI) ;
  10183.  
  10184. * ---- Actualisation des points milieux
  10185.  
  10186. TAB1.<CHP_X1 = CHP_X1 ;
  10187. TAB1.<CHP_Y1 = CHP_Y1 ;
  10188. TAB1.<CHP_Z1 = CHP_Z1 ;
  10189.  
  10190. *MESS '---------------------------------> exiting @DMILIEU';
  10191. FINPROC DEPX0 DEPY0 DEPZ0 ;
  10192. **** @DMOYEN
  10193.  
  10194. DEBPROC @DMOYEN CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT PASB0*FLOTTANT CHSIGN/CHPOINT TAB1*TABLE;
  10195.  
  10196.  
  10197. *MESS '---------------------------------> calling @DMOYEN';
  10198.  
  10199. *--------------- VARIABLES D'ENTREE :
  10200. TYPCAL = TAB1.<TYPE_CALCUL ;
  10201. *------------------------------------
  10202. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  10203. ISHIFT = VRAI ;
  10204. IRIPPLE = VRAI ;
  10205. FINSI ;
  10206. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  10207. ISHIFT = VRAI ;
  10208. IRIPPLE = FAUX ;
  10209. FINSI ;
  10210. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  10211. ISHIFT = FAUX ;
  10212. IRIPPLE = VRAI ;
  10213. FINSI ;
  10214. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  10215. ISHIFT = FAUX ;
  10216. IRIPPLE = FAUX ;
  10217. FINSI ;
  10218. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  10219. ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
  10220. FINSI ;
  10221. *
  10222. SI (EGA (TYPE CHSIGN) MOT) ;
  10223. * --- Cas ou l'appel vient d'une proc qui n'a pas calcule CHSIGN
  10224. CHSIGN = 1. ;
  10225. FINSI ;
  10226.  
  10227. * ---- Calcul du champ dans le repere global
  10228. BXG BYG BZG FSECU = @CHAMB TAB1 CHP_X CHP_Y CHP_Z ISHIFT IRIPPLE ;
  10229.  
  10230. * ---- Calcul de la norme du champ
  10231.  
  10232. NORM_B = ((BXG*BXG) + (BYG*BYG) + (BZG*BZG))**0.5 ;
  10233.  
  10234. * ---- Calcul du point extremite par la methode des tangentes
  10235.  
  10236. XG_NEW0 = CHP_X + (CHSIGN * BXG * PASB0 / NORM_B) ;
  10237. YG_NEW0 = CHP_Y + (CHSIGN * BYG * PASB0 / NORM_B) ;
  10238. ZG_NEW0 = CHP_Z + (CHSIGN * BZG * PASB0 / NORM_B) ;
  10239.  
  10240.  
  10241.  
  10242. * ---- Calcul du champ magnetique dans le repere global
  10243. * ---- sur le point extremite
  10244.  
  10245.  
  10246. BXG0 BYG0 BZG0 FSECU = @CHAMB TAB1 XG_NEW0 YG_NEW0 ZG_NEW0 ISHIFT IRIPPLE ;
  10247.  
  10248.  
  10249. * ---- Moyenne des champs magnetiques
  10250.  
  10251. BXG1 = (BXG + BXG0)/2. ;
  10252. BYG1 = (BYG + BYG0)/2. ;
  10253. BZG1 = (BZG + BZG0)/2. ;
  10254.  
  10255.  
  10256. * ---- Calcul de la norme du champ moyenne
  10257.  
  10258. NORM_B1 = ((BXG1*BXG1) + (BYG1*BYG1) + (BZG1*BZG1))**0.5 ;
  10259.  
  10260. * ---- Calcul des deplacements
  10261.  
  10262. DEPX0 = BXG1 * PASB0 / NORM_B1 ;
  10263. DEPY0 = BYG1 * PASB0 / NORM_B1 ;
  10264. DEPZ0 = BZG1 * PASB0 / NORM_B1 ;
  10265.  
  10266. *MESS '---------------------------------> exiting @DMOYEN';
  10267. FINPROC DEPX0 DEPY0 DEPZ0 ;
  10268. **** @DPSI
  10269.  
  10270. DEBPROC @DPSI TAB1*TABLE ;
  10271.  
  10272. *************************************************************
  10273. * Procedure de calcul de dpsi en chaque point d'un maillage *
  10274. * donne. Alain MOAL (Novembre 2001) *
  10275. *************************************************************
  10276. *
  10277. MESS '---------------------------------> calling @DPSI';
  10278. *
  10279. *--------------- VARIABLES D'ENTREE :
  10280. CHB0 = TAB1.<CARTE_B ;
  10281. GRILB0 = TAB1.<GRILLE_B ;
  10282. MAIL1 = TAB1.<MAILLAGE_B ;
  10283. *------------------------------------
  10284. *TRAC (MAIL1 ET GRILB0) ;
  10285. CHEL1 = CHAN CHAM CHB0 GRILB0 ;
  10286. CHPO1 = PROI MAIL1 CHEL1 1.E-4;
  10287. CHDPSI = EXCO 'DPSI' CHPO1 ;
  10288. *
  10289. MESS '---------------------------------> exiting @DPSI';
  10290. FINPROC CHDPSI ;
  10291.  
  10292. **** @DREPROJ
  10293.  
  10294. DEBPROC @DREPROJ CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT PASB0*FLOTTANT CHSIGN/CHPOINT TAB1*TABLE ;
  10295.  
  10296. ****************************************************************
  10297. * Procedure de calcul du deplacement pour remonter des lignes *
  10298. * de champ magnetique, a partir des CHPOINT de coordonnees *
  10299. * methode utilisant une reprojection sur la SMF *
  10300. * ---> construit un chpoint appuye sur l'objet etudie et *
  10301. * contenant pour chaque point le deplacement sur un pas pour *
  10302. * remonter les lignes de champ *
  10303. ****************************************************************
  10304.  
  10305. *MESS '---------------------------------> calling @DREPROJ';
  10306.  
  10307. *--------------- VARIABLES D'ENTREE :
  10308. TYPCAL = TAB1.<TYPE_CALCUL ;
  10309. RR = TAB1.<RR ;
  10310. EPS0 = TAB1.<EPS ;
  10311. NBOB = TAB1.<NBOB ;
  10312. COEFA = TAB1.<COEFA ;
  10313. COEFB = TAB1.<COEFB ;
  10314. COEFC = TAB1.<COEFC ;
  10315. * (pour info) TAB1.<CHSIGN ;
  10316. *------------------------------------
  10317. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  10318. ISHIFT = VRAI ;
  10319. IRIPPLE = VRAI ;
  10320. FINSI ;
  10321. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  10322. ISHIFT = VRAI ;
  10323. IRIPPLE = FAUX ;
  10324. FINSI ;
  10325. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  10326. ISHIFT = FAUX ;
  10327. IRIPPLE = VRAI ;
  10328. FINSI ;
  10329. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  10330. ISHIFT = FAUX ;
  10331. IRIPPLE = FAUX ;
  10332. FINSI ;
  10333. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  10334. ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
  10335. FINSI ;
  10336. *
  10337. SI (EGA (TYPE CHSIGN) MOT) ;
  10338. * --- Cas ou l'appel vient d'une proc qui n'a pas calcule CHSIGN
  10339. CHSIGN = 1. ;
  10340. FINSI ;
  10341.  
  10342.  
  10343. * ---- Calcul du champ dans le repere global
  10344. BXG BYG BZG FSECU = @CHAMB TAB1 CHP_X CHP_Y CHP_Z ISHIFT IRIPPLE ;
  10345.  
  10346.  
  10347. * ---- Calcul de la norme du champ
  10348.  
  10349. NORM_B = ((BXG*BXG) + (BYG*BYG) + (BZG*BZG))**0.5 ;
  10350.  
  10351.  
  10352. *
  10353. XG_NEW0 = CHP_X + (CHSIGN * BXG * PASB0 / NORM_B) ;
  10354. YG_NEW0 = CHP_Y + (CHSIGN * BYG * PASB0 / NORM_B) ;
  10355. ZG_NEW0 = CHP_Z + (CHSIGN * BZG * PASB0 / NORM_B) ;
  10356.  
  10357. * ---- Coordonnees dans le repere
  10358. * ---- pseudo-toroidal du ripple
  10359. RHOR THER PHIR = @CRGTC CHP_X CHP_Y CHP_Z RR 0. ;
  10360. RHOR_OLD = RHOR ;
  10361. KAUX = (EXP (THER ** 2 * -1. * COEFC))* ((COS (PHIR * NBOB)) * -1. + 1.) * COEFA ;
  10362. I3 = 0 ;
  10363. REPETER BOUCLE3 50 ;
  10364. * I3 =I3 + 1 ; MESS ' I3 =' I3 ;
  10365. RHOR_NEW = RHOR + (KAUX * (EXP(RHOR_OLD * COEFB)));
  10366. SI ((MAXI (ABS((RHOR_NEW - RHOR_OLD)/RHOR_NEW))) &lt;EG EPS0) ;
  10367. QUITTER BOUCLE3 ;
  10368. FINSI ;
  10369. RHOR_OLD = RHOR_NEW ;
  10370. FIN BOUCLE3 ;
  10371.  
  10372. RHOMER = RHOR_NEW ;
  10373.  
  10374. I2 = 0 ;
  10375. REPETER BOUCLE2 2 ;
  10376. I2 =I2 + 1 ;
  10377. * MESS ' I2 =' I2 ;
  10378. * ---- point sur la surface magnetique
  10379. RHORN THERN PHIRN = @CRGTC XG_NEW0 YG_NEW0 ZG_NEW0 RR 0. ;
  10380. DRHOMERN = (EXP (RHOMER*COEFB))*(EXP(THERN**2 *COEFC * -1.)) * COEFA ;
  10381. RHORIP = DRHOMERN * ((COS(PHIRN * NBOB)) - 1.) + RHOMER ;
  10382.  
  10383. XG_NEW1 YG_NEW1 ZG_NEW1 = @CRTGC RHORIP THERN PHIRN RR 0. ;
  10384. *
  10385. * ---- Calcul du champ dans le repere global
  10386. BXG0 BYG0 BZG0 FSECU0 = @CHAMB TAB1 XG_NEW1 YG_NEW1 ZG_NEW1 ISHIFT IRIPPLE ;
  10387.  
  10388. * ---- Moyenne des tangentes
  10389. BXG1 = (BXG + BXG0)/2. ;
  10390. BYG1 = (BYG + BYG0)/2. ;
  10391. BZG1 = (BZG + BZG0)/2. ;
  10392.  
  10393. NORM_B1 = ((BXG1*BXG1) + (BYG1*BYG1) + (BZG1*BZG1))**0.5 ;
  10394.  
  10395. XG_NEW0 = CHP_X + (CHSIGN * BXG1 * PASB0 / NORM_B1) ;
  10396. YG_NEW0 = CHP_Y + (CHSIGN * BYG1 * PASB0 / NORM_B1) ;
  10397. ZG_NEW0 = CHP_Z + (CHSIGN * BZG1 * PASB0 / NORM_B1) ;
  10398.  
  10399. SI (I2 EGA 2);
  10400. XG_NEW = XG_NEW0 ;
  10401. YG_NEW = YG_NEW0 ;
  10402. ZG_NEW = ZG_NEW0 ;
  10403. FINSI ;
  10404.  
  10405. FIN BOUCLE2 ;
  10406.  
  10407. * ---- Calcul des deplacements
  10408.  
  10409. DEPX0 = BXG1 * PASB0 / NORM_B1 ;
  10410. DEPY0 = BYG1 * PASB0 / NORM_B1 ;
  10411. DEPZ0 = BZG1 * PASB0 / NORM_B1 ;
  10412.  
  10413.  
  10414.  
  10415. *MESS '---------------------------------> exiting @DREPROJ';
  10416. FINPROC DEPX0 DEPY0 DEPZ0 ;
  10417. 'DEBPROC' EPSCHL MOD_1*MMODEL SI_13*MCHAM TE0*CHPOINT TE1*CHPOINT TAB1/'TABLE ' ;
  10418. SI (( NON ( EXISTE MAT_1)) ET ( EXISTE TAB1)) ;
  10419. I1 = 0 ;
  10420. REPETER BOMA11 ;
  10421. I1 = I1 + 1 ;
  10422. SI ( EXISTE (TAB1.ZONE_MAT) I1 ) ;
  10423. MO1 = TAB1.MODL_MAT. I1 ;
  10424. TM_1 = ( REDU TE1 TAB1.ZONE_MAT.I1 ) ;
  10425. Y_1 = VARI TM_1 TAB1.TETMAT.MO1.YOUN YOUN ;
  10426. NU_1 = VARI TM_1 TAB1.TETMAT.MO1.NU NU ;
  10427. AL_1 = VARI TM_1 TAB1.TETMAT.MO1.ALPH ALPH ;
  10428. NU_1 = CHANGER CHAM NU_1 MO1 'RIGIDITE' ;
  10429. Y_1 = CHANGER CHAM Y_1 MO1 'RIGIDITE' ;
  10430. AL_1 = CHANGER CHAM AL_1 MO1 'RIGIDITE' ;
  10431. TEX1 = TEXTE 'YOUN Y_1 NU NU_1 ALPH AL_1' ;
  10432. IMOTM1 = DIME (MOTS TAB1.TEXTMECA.I1) ;
  10433. SI ( IMOTM1 EGA 5 ) ;
  10434. TEX1 = TEXTE TEX1 'SIGY YM_1 ' ;
  10435. TITRE 'MAT' I1 ' YIELD MODULUS' ;
  10436. YM_1 = VARI TM_1 TAB1.TETMAT.MO1.SIGY SIGY ;
  10437. YM_1 = CHANGER CHAM YM_1 MO1 'RIGIDITE' ;
  10438. TEX1 = TEXTE TEX1 'H H_1 ' ;
  10439. H_1 = VARI TM_1 TAB1.TETMAT.MO1.H H ;
  10440. H_1 = CHANGER CHAM H_1 MO1 'RIGIDITE' ;
  10441. FINSI ;
  10442. MA1 = MATE MO1 TEX1 ;
  10443. SINON ;
  10444. QUITTER BOMA11 ;
  10445. FINSI ;
  10446. SI ( I1 EGA 1 ) ;
  10447. MOD_1 = MO1 ;
  10448. MAT_1 = MA1 ;
  10449. SINON ;
  10450. MOD_1 = MOD_1 ET MO1 ;
  10451. MAT_1 = MAT_1 ET MA1 ;
  10452. FINSI ;
  10453. FIN BOMA11 ;
  10454. FINSI ;
  10455. TAB1.MATTOT = MAT_1 ;
  10456. SI_11 = THETA MAT_1 ( TE1 - TE0 ) ;
  10457. FO1 = BSIGMA SI_11 ;
  10458. SI_12 = SI_13 + SI_11 ;
  10459. EPS_1 = ELAS MOD_1 SI_12 MAT_1 FINPROC EPS_1 ;**** @EPTH DEBPROC @EPTH CHT1*CHPOINT EV1*EVOLUTION MOD1*MMODEL;
  10460.  
  10461. CHT2 = REDU CHT1 ( EXTR MOD1 'MAIL');
  10462. ALP1 = VARI MOD1 CHT2 EV1;
  10463. ALP2 = CHAN CHPO ALP1 MOD1 ;
  10464. ALP3 = NOMC ALP2 'SCAL' ;
  10465.  
  10466.  
  10467. EPS1 = ALP3 * CHT2;
  10468.  
  10469. EPX1 = NOMC EPS1 'EPXX';
  10470. EPY1 = NOMC EPS1 'EPYY';
  10471. EPZ1 = NOMC EPS1 'EPZZ';
  10472. GAXY1 = NOMC (0. * EPS1) 'GAXY';
  10473. GAXZ1 = NOMC (0. * EPS1) 'GAXZ';
  10474. GAYZ1 = NOMC (0. * EPS1) 'GAYZ';
  10475.  
  10476. EPX2 = CHAN CHAM EPX1 MOD1 'STRESSES';
  10477. EPY2 = CHAN CHAM EPY1 MOD1 'STRESSES';
  10478. EPZ2 = CHAN CHAM EPZ1 MOD1 'STRESSES';
  10479. GAXY2 = CHAN CHAM GAXY1 MOD1 'STRESSES';
  10480. GAXZ2 = CHAN CHAM GAXZ1 MOD1 'STRESSES';
  10481. GAYZ2 = CHAN CHAM GAYZ1 MOD1 'STRESSES';
  10482.  
  10483. EPS_THER = EPX2 ET EPY2 ET EPZ2 ET GAXY2 ET GAXZ2 ET GAYZ2;
  10484.  
  10485.  
  10486. FINPROC EPS_THER ;
  10487.  
  10488.  
  10489. **** @ET
  10490. DEBPROC @ET CH1*CHPOINT CH2*CHPOINT ;
  10491. CHA1 = CHAN 'ATTRIBUT ' CH1 'NATURE' 'DISCRET' ;
  10492. CHA2 = CHAN 'ATTRIBUT ' CH2 'NATURE' 'DISCRET' ;
  10493. CHR = CHA1 ET CHA2;
  10494. FINPROC CHR ;
  10495. **** @EVMAA
  10496. DEBPROC @EVMAA NOMM*MOT TIN1*FLOTTANT ;
  10497.  
  10498. EVE2 = @EVMAT NOMM 'ALPHA' ;
  10499. LLTE1 = EXTR EVE2 'ABSC' ;
  10500. KK1 = MINI ( ABS ( LLTE1 - (PROG (DIME LLTE1) * TIN1)));
  10501.  
  10502. SI (KK1 EGA 0. 1. ) ;
  10503. LLTE1 = LLTE1 + (PROG (DIME LLTE1) * 10.) ;
  10504. PP1 = @IPOE LLTE1 EVE2 FIXE ;
  10505. EVE2 = EVOL MANU 'TEMPERATURE' LLTE1 'ALPH' PP1 ;
  10506. FINSI ;
  10507.  
  10508. EVOC700 = EVOL MANU 'TEMPERATURE' LLTE1 'ALPH' ( PROG (DIME LLTE1) * (TIN1 - 20.)) ;
  10509.  
  10510. EVOCT1 = EVOL MANU 'TEMPERATURE' LLTE1 'ALPH' (LLTE1 - (PROG (DIME LLTE1) * 20.)) ;
  10511.  
  10512. EVOCTY1 = EVOL MANU 'TEMPERATURE' LLTE1 'ALPH' (PROG (DIME LLTE1) * ((TIN1 - 20.) * (EVMAT NOMM 'ALPHA' TIN1)));
  10513.  
  10514. BETA1 = ((EVOCTY1 - (EVE2 * EVOCT1))/(EVOC700 - EVOCT1)) ;
  10515.  
  10516. FINPROC BETA1 ;
  10517. **** @EVMAT
  10518. 'DEBPROC' @EVMAT MOT1*'MOT ' MOT2*'MOT ' VAL1/FLOTTANT CHP1/CHPOINT TABTT/TABLE ;
  10519. *23456789012345678901234567890123456789012345678901234567890123456789012
  10520. * 1 2 3 4 5 6 7
  10521. * version cr\E9ee 19.12.96 par R. Mitteau pour fonctionner avec PASAPAS
  10522. *modification des noms de composantes :
  10523. * 'TEMPERATURE' -> 'T'
  10524. * 'CONDUCTIVITE' -> 'K'
  10525. * 'CAPACITE' -> 'CapaVolu'
  10526.  
  10527. SI ( EXISTE TABTT) ;
  10528. TABT = TABLE TABTT ;
  10529. SINON ;
  10530. TABT = TABLE ;
  10531. FINSI ;
  10532. TT1 = TABLE ;
  10533. REPETER BLOC1 1 ;
  10534.  
  10535. SI ( EGA MOT1 'DUNLOP' ) ;
  10536. * donnees bonnal 19 avril 93
  10537. TT1.'DUNLOP' = TABLE ;
  10538. TT1.'DUNLOP' . 'K' 'T' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 3.5E3) 'K'(PROG 459. 459. 446. 418. 390. 364. 341. 320. 302. 286. 273. 261. 250. 241. 233. 227. 220. 215. 190. 150. 110 51.) ;
  10539. *TITRE ' DUNLOP SPECIF HEAT' ;
  10540. TT1.'DUNLOP' . 'C' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 3.5E3) 'C' (PROG 708. 708. 789. 937. 1066. 1178. 1274. 1357. 1431. 1495.4 1552.4 1603.2 1648.7 1689.7 1726.8 1760.5 1791.3 1819.6 1820. 2000. 2050. 2100.) ;
  10541.  
  10542. *TITRE ' DUNLOP DENSITY' ;
  10543. TT1.'DUNLOP' . 'RHO' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 3.5E3) 'RHO' (PROG 1903. 1903. 1902. 1902. 1901. 1901. 1900. 1900. 1899. 1899. 1898. 1898. 1897. 1897. 1897. 1896. 1896. 1895. 1894. 1890. 1890. 1890. );
  10544.  
  10545. EVRHOC = (TT1.'DUNLOP' . 'RHO') * ( TT1.'DUNLOP' . 'C') ;
  10546. TT1.'DUNLOP' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10547. QUITTER BLOC1 ;
  10548. FINSI ;
  10549. ***********************************************************************
  10550. * N11 redensifie direction P
  10551. * materiau rentre par Raphael Mitteau le 6 juin 1996
  10552. * Source SEP lineaire entre 20 et 1000 C
  10553. SI ( EGA MOT1 'N11P_DENSE1' ) ;
  10554. *
  10555. * --- definition de la table
  10556. *
  10557. TT1.'N11P_DENSE1' = TABLE ;
  10558. *
  10559. * --- definition de la conductivite thermique
  10560. *
  10561. TT1.'N11P_DENSE1' . 'K' = EVOL MANU 'T' (PROG -200. 20. 1000. ) 'K' (PROG 250. 250. 100.) ;
  10562. *
  10563. * --- tout est defini, on quitte les bloc de definition des materiaux
  10564. *
  10565. QUITTER BLOC1 ;
  10566. FINSI ;
  10567. * N11 redensifie direction P
  10568. * materiau rentre par Raphael Mitteau le 6 juin 1996
  10569. * Source SEP a 20 et 1000 C copie variation N11
  10570. SI ( EGA MOT1 'N11P_DENSE2' ) ;
  10571. *
  10572. * --- definition de la table
  10573. *
  10574. TT1.'N11P_DENSE2' = TABLE ;
  10575. *
  10576. * --- definition de la conductivite thermique
  10577. *
  10578. TT1.'N11P_DENSE2' . 'K' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.) 'K' (((((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1 165. 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 91.69 75.17 65.28 58.52 43.95) - (PROG 23. * 102.6 ))/ (247.8 - 102.6))*(150.)) + (PROG 23. * 100.));
  10579. *
  10580. * --- tout est defini, on quitte les bloc de definition des materiaux
  10581. *
  10582. QUITTER BLOC1 ;
  10583. FINSI ;
  10584. ***********************************************************************
  10585. * Dunlop concept 1 conductivite dana la direction X mesure par CEA
  10586. * materiau rentre par Raphael Mitteau le 5 juin 1996
  10587. * source CEA/DRN/DMT 95-495 rapport de J.P. Bonal
  10588. SI ( EGA MOT1 'DUN_C1_BONAL_X' ) ;
  10589. *
  10590. * --- definition de la table
  10591. *
  10592. TT1.'DUN_C1_BONAL_X' = TABLE ;
  10593. *
  10594. * --- definition de la conductivite thermique
  10595. *
  10596. TT1.'DUN_C1_BONAL_X' . 'K' = EVOL MANU 'T' (PROG -200. 25 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. ) 'K' (PROG 430.6 430.6 425.7 406.5 382.4 358.0 335.1 314.4 295.9 279.5 264.9 252. 240.5 230.2 221.0 212.7 205.3 198.5 ) ;
  10597. *
  10598. * --- tout est defini, on quitte les bloc de definition des materiaux
  10599. *
  10600. QUITTER BLOC1 ;
  10601. FINSI ;
  10602. ***********************************************************************
  10603. * Dunlop concept 1 conductivite dana la direction X mesure par CEA
  10604. * materiau rentre par Raphael Mitteau le 5 juin 1996
  10605. * source CEA/DRN/DMT 95-495 rapport de J.P. Bonal
  10606. SI ( EGA MOT1 'DUN_C1_BONAL_Y' ) ;
  10607. *
  10608. * --- definition de la table
  10609. *
  10610. TT1.'DUN_C1_BONAL_Y' = TABLE ;
  10611. *
  10612. * --- definition de la conductivite thermique
  10613. *
  10614. TT1.'DUN_C1_BONAL_Y' . 'K' = EVOL MANU 'T' (PROG -200. 25 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. ) 'K'(PROG 102.4 102.4 102.4 99.9 95.6 90.8 86.0 81.4 77.2 73.4 69.9 66.8 63.9 61.3 58.9 56.7 54.7 52.9 ) ;
  10615. *
  10616. * --- tout est defini, on quitte les bloc de definition des materiaux
  10617. *
  10618. QUITTER BLOC1 ;
  10619. FINSI ;
  10620. ***********************************************************************
  10621. * Sepcarb NB31 Version C conductivite dana la direction X
  10622. * materiau rentre par Raphael Mitteau le 5 juin 1996
  10623. * source SEP
  10624. SI ( EGA MOT1 'NB31CX' ) ;
  10625. *
  10626. * --- definition de la table
  10627. *
  10628. TT1.'NB31CX' = TABLE ;
  10629. *
  10630. * --- definition de la conductivite thermique
  10631. *
  10632. * --- approximation lineaire
  10633. TT1.'NB31CX' . 'K' = EVOL MANU 'T' (PROG -200. 20. 800. 1000. 2000.) 'K' (PROG 323. 323. 154. 145. 145. ) ;
  10634.  
  10635. * --- variation copiee sur celle du N11
  10636. TT1.'NB31CX' . 'K' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.) 'K' (((((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1 165. 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 91.69 75.17 65.28 58.52 43.95) - (PROG 23. * 102.6 ))/ (247.8 - 102.6))*(323. - 154.)) + (PROG 23. * 154.));
  10637. *
  10638. * --- tout est defini, on quitte les bloc de definition des materiaux
  10639. *
  10640. QUITTER BLOC1 ;
  10641. FINSI ;
  10642. ***********************************************************************
  10643. * Sepcarb NB31 Version C conductivite dans la direction Y
  10644. * materiau rentre par Raphael Mitteau le 5 juin 1996
  10645. * source SEP
  10646. SI ( EGA MOT1 'NB31CY' ) ;
  10647. *
  10648. * --- definition de la table
  10649. *
  10650. TT1.'NB31CY' = TABLE ;
  10651. *
  10652. * --- definition de la conductivite thermique
  10653. *
  10654.  
  10655. * --- approximation lineaire
  10656.  
  10657. TT1.'NB31CY' . 'K' = EVOL MANU 'T' (PROG -200. 20. 800. 1000. 2000.) 'K'(PROG 117. 117. 58. 56. 56. ) ;
  10658.  
  10659. * --- variation copiee sur celle du N11
  10660.  
  10661. TT1.'NB31CY' . 'K' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.) 'K' (((((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1 165. 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 91.69 75.17 65.28 58.52 43.95) - (PROG 23. * 102.6 ))/ (247.8 - 102.6))*(117. - 58. )) + (PROG 23. * 58.));
  10662. *
  10663. * --- tout est defini, on quitte les bloc de definition des materiaux
  10664. *
  10665. QUITTER BLOC1 ;
  10666. FINSI ;
  10667. ***********************************************************************
  10668. * Sepcarb NB31 Version C conductivite dans la direction Z
  10669. * materiau rentre par Raphael Mitteau le 5 juin 1996
  10670. * source SEP
  10671. SI ( EGA MOT1 'NB31CZ' ) ;
  10672. *
  10673. * --- definition de la table
  10674. *
  10675. TT1.'NB31CZ' = TABLE ;
  10676. *
  10677. * --- definition de la conductivite thermique
  10678. *
  10679. TT1.'NB31CZ' . 'K' = EVOL MANU 'T' (PROG -200. 20. 800. 1000. 2000.) 'K'(PROG 115. 115. 55. 52. 52. ) ;
  10680. *
  10681. * --- tout est defini, on quitte les bloc de definition des materiaux
  10682. *
  10683. QUITTER BLOC1 ;
  10684. FINSI ;
  10685.  
  10686. ***********************************************************************
  10687. * Sepcarb NS31 Version C conductivite dans la direction X
  10688. * materiau rentre par Raphael Mitteau le 10 septembre 1996
  10689. * source SEP
  10690. SI ( EGA MOT1 'NS31CX' ) ;
  10691. *
  10692. * --- definition de la table
  10693. *
  10694. TT1.'NS31CX' = TABLE ;
  10695. *
  10696. * --- definition de la conductivite thermique
  10697. *
  10698. * --- approximation lineaire
  10699. TT1.'NS31CX' . 'K' = EVOL MANU 'T' (PROG -200. 20. 800. 1000. 2000.) 'K' (PROG 304. 304. 149. 141. 141. ) ;
  10700.  
  10701. * --- variation copiee sur celle du N11
  10702. TT1.'NS31CX' . 'K' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.) 'K' (((((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1 165. 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 91.69 75.17 65.28 58.52 43.95) - (PROG 23. * 102.6 ))/ (247.8 - 102.6))*(304. - 149.)) + (PROG 23. * 149.));
  10703. *
  10704. * --- tout est defini, on quitte les bloc de definition des materiaux
  10705. *
  10706. QUITTER BLOC1 ;
  10707. FINSI ;
  10708. ***********************************************************************
  10709. * Sepcarb NS31 Version C conductivite dans la direction Y
  10710. * materiau rentre par Raphael Mitteau le 10 septembre 1996
  10711. * source SEP
  10712. SI ( EGA MOT1 'NS31CY' ) ;
  10713. *
  10714. * --- definition de la table
  10715. *
  10716. TT1.'NS31CY' = TABLE ;
  10717. *
  10718. * --- definition de la conductivite thermique
  10719. *
  10720.  
  10721. * --- approximation lineaire
  10722.  
  10723. TT1.'NS31CY' . 'K' = EVOL MANU 'T' (PROG -200. 20. 800. 1000. 2000.) 'K'(PROG 100. 100. 55. 54. 54. ) ;
  10724.  
  10725. * --- variation copiee sur celle du N11
  10726.  
  10727. TT1.'NS31CY' . 'K' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.) 'K' (((((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1 165. 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 91.69 75.17 65.28 58.52 43.95) - (PROG 23. * 102.6 ))/ (247.8 - 102.6))*(100. - 55. )) + (PROG 23. * 55.));
  10728. *
  10729. * --- tout est defini, on quitte les bloc de definition des materiaux
  10730. *
  10731. QUITTER BLOC1 ;
  10732. FINSI ;
  10733. ***********************************************************************
  10734. * Sepcarb NB31 Version C conductivite dans la direction Z
  10735. * materiau rentre par Raphael Mitteau le 10 septembre 1996
  10736. * source SEP
  10737. SI ( EGA MOT1 'NS31CZ' ) ;
  10738. *
  10739. * --- definition de la table
  10740. *
  10741. TT1.'NS31CZ' = TABLE ;
  10742. *
  10743. * --- definition de la conductivite thermique
  10744. *
  10745. TT1.'NS31CZ' . 'K' = EVOL MANU 'T' (PROG -200. 20. 800. 1000. 2000.) 'K'(PROG 91. 91. 48. 43. 43. ) ;
  10746. *
  10747. * --- variation copiee sur celle du N11
  10748. *
  10749.  
  10750. TT1.'NS31CZ' . 'K' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.) 'K' (((((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1 165. 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 91.69 75.17 65.28 58.52 43.95) - (PROG 23. * 102.6 ))/ (247.8 - 102.6))*(91. - 48. )) + (PROG 23. * 48.));
  10751. *
  10752. * --- tout est defini, on quitte les bloc de definition des materiaux
  10753. *
  10754. QUITTER BLOC1 ;
  10755. FINSI ;
  10756.  
  10757. ***********************************************************************
  10758. * stands for DUNLOP CONCEPT 1
  10759. * valeurs rentrees le 04 mai 95 par J.F. Salavy
  10760.  
  10761. * source : DUNLOP LIMITED AVIATION DIVISION (net supply contract
  10762. * no 92-825A) envoyees par Ivi Smid le 29/03/95
  10763. * donnees entre 25 et 1200 C
  10764. * Pour cond_Z, les valeurs sont celles de la courbe et non du tableau
  10765.  
  10766. SI ( EGA MOT1 'DUN_CONCEPT1_X' ) ;
  10767.  
  10768. TT1.'DUN_CONCEPT1_X' = TABLE ;
  10769.  
  10770. TT1.'DUN_CONCEPT1_X' . 'K' = EVOL MANU 'T' (PROG -5000. 25. 100. 200. 300. 400. 500. 600. 700. 800. 900. 1000. 1100. 1200. 2000. 5000.) 'K'(PROG 112. 112. 106. 92. 84. 74. 67. 64. 57. 56. 50. 49. 45. 42. 30. 10. ) ;
  10771.  
  10772. TT1.'DUN_CONCEPT1_X' . 'C' = EVOL MANU 'T' (PROG -5000. 25. 100. 200. 300. 400. 500. 600. 700. 800. 900. 1000. 1100. 1200. 5000. ) 'C' (PROG 710. 710. 934. 1171. 1363. 1506. 1621. 1706. 1779. 1835. 1884. 1924. 1960. 1990. 1990. ) ;
  10773.  
  10774. TT1.'DUN_CONCEPT1_X' . 'RHO' = EVOL MANU 'T' (PROG -5000. 25. 100. 200. 300. 400. 500. 600. 700. 800. 900. 1000. 1100. 1200. 5000. ) 'RHO' (PROG 1910. 1910. 1907. 1905. 1903. 1900. 1896. 1893. 1890. 1887. 1885. 1883. 1880. 1880. 1880. );
  10775.  
  10776. EVRHOC = ( TT1.'DUN_CONCEPT1_X' . 'RHO') * ( TT1.'DUN_CONCEPT1_X' . 'C');
  10777.  
  10778. TT1.'DUN_CONCEPT1_X' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10779.  
  10780. QUITTER BLOC1 ;
  10781. FINSI ;
  10782.  
  10783. SI ( EGA MOT1 'DUN_CONCEPT1_Y' ) ;
  10784.  
  10785. TT1.'DUN_CONCEPT1_Y' = TABLE ;
  10786.  
  10787. TT1.'DUN_CONCEPT1_Y' . 'K' = EVOL MANU 'T' (PROG -5000. 25. 100. 200. 300. 400. 500. 600. 700. 800. 900. 1000. 1100. 1200. 2000. 5000. ) 'K'(PROG 78. 78. 73. 66. 59. 53. 48. 45. 40. 39. 37. 33. 33. 31. 30. 20. ) ;
  10788.  
  10789. TT1.'DUN_CONCEPT1_Y' . 'C' = EVOL MANU 'T' (PROG -5000. 25. 100. 200. 300. 400. 500. 600. 700. 800. 900. 1000. 1100. 1200. 5000. ) 'C' (PROG 719. 719. 923. 1182. 1368. 1507. 1623. 1706. 1776. 1834. 1883. 1924. 1959. 1990. 1990. );
  10790.  
  10791. TT1.'DUN_CONCEPT1_Y' . 'RHO' = EVOL MANU 'T' (PROG -5000. 25. 100. 200. 300. 400. 500. 600. 700. 800. 900. 1000. 1100. 1200. 5000. ) 'RHO' (PROG 1940. 1940. 1937. 1935. 1933. 1930. 1926. 1923. 1920. 1917. 1915. 1913. 1910. 1910. 1910. );
  10792.  
  10793. EVRHOC = ( TT1.'DUN_CONCEPT1_Y' . 'RHO') * ( TT1.'DUN_CONCEPT1_Y' . 'C');
  10794.  
  10795. TT1.'DUN_CONCEPT1_Y' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10796.  
  10797. QUITTER BLOC1 ;
  10798. FINSI ;
  10799.  
  10800. SI ( EGA MOT1 'DUN_CONCEPT1_Z' ) ;
  10801.  
  10802. TT1.'DUN_CONCEPT1_Z' = TABLE ;
  10803.  
  10804. TT1.'DUN_CONCEPT1_Z' . 'K' = EVOL MANU 'T' (PROG -5000. 20. 100. 200. 300. 400. 500. 600. 700. 800. 900. 1000. 1100. 1200. 2000. 5000. ) 'K'(PROG 351. 351. 330. 300. 275. 248. 225. 211. 190. 170. 150. 140. 125. 115. 100. 100. ) ;
  10805.  
  10806. TT1.'DUN_CONCEPT1_Z' . 'C' = EVOL MANU 'T' (PROG -5000. 25. 100. 200. 300. 400. 500. 600. 700. 800. 900. 1000. 1100. 1200. 5000. ) 'C' (PROG 695. 695. 923. 1173. 1362. 1508. 1620. 1706. 1777. 1837. 1883. 1925. 1960. 1989. 1989. );
  10807.  
  10808. TT1.'DUN_CONCEPT1_Z' . 'RHO' = EVOL MANU 'T' (PROG -5000. 25. 100. 200. 300. 400. 500. 600. 700. 800. 900. 1000. 1100. 1200. 5000. ) 'RHO' (PROG 1800. 1800. 1797. 1795. 1793. 1790. 1786. 1783. 1780. 1777. 1775. 1773. 1770. 1770. 1770. );
  10809.  
  10810. EVRHOC = ( TT1.'DUN_CONCEPT1_Z' . 'RHO') * ( TT1.'DUN_CONCEPT1_Z' . 'C');
  10811.  
  10812. TT1.'DUN_CONCEPT1_Z' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10813.  
  10814. QUITTER BLOC1 ;
  10815. FINSI ;
  10816. **********************************************************************
  10817.  
  10818. LL1 = (( EGA MOT1 'DUNX' ) OU ( EGA MOT1 'I1DUNX' ) OU ( EGA MOT1 'DUNY' ) OU ( EGA MOT1 'I1DUNY' ));
  10819. SI LL1 ;
  10820. * Valeurs fournies par Deschamps le 12/02/93 a 20. et 1000. degres C
  10821. TT1.'DUNX' = TABLE ;
  10822. *
  10823. TT1.'DUNX' . 'K' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 3.5E3) 'K'(PROG 459. 459. 446. 418. 390. 364. 341. 320. 302. 286. 273. 261. 250. 241. 233. 227. 220. 215. 190. 150. 110 51.) ;
  10824. *
  10825.  
  10826. TT1.'DUNY' = TABLE ;
  10827. *
  10828. TT1.'DUNY' . 'K' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 3.5E3) 'K'(PROG 92. 92. 91.3 89. 85.8 82.2 78.5 74.9 71.6 68.5 65.6 63 60.6 58.4 56.4 54.5 52.8 51.2 45. 35. 22. 51.) ;
  10829. *
  10830. *
  10831. * Valeurs fournies par Deschamps le 12/02/93 a 20. et 1000. degres C
  10832. TT1.'I1DUNX' = TABLE ;
  10833. *
  10834.  
  10835. P_COEF = prog .21 .21 .23 .26 .29 .33 .36 .39 .41 .44 .46 .48 .5 .52 .52 .52 .52 .52 .515 .51 .5 .5 ;
  10836. TT1.'I1DUNX' . 'K' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 3.5E3) 'K'((PROG 459. 459. 446. 418. 390. 364. 341. 320. 302. 286. 273. 261. 250. 241. 233. 227. 220. 215. 190. 150. 110 51.)*P_COEF) ;
  10837. *
  10838. TT1.'I1DUNY' = TABLE ;
  10839. *
  10840. P_COEF = prog .21 .21 .23 .26 .29 .33 .36 .39 .41 .44 .46 .48 .5 .52 .52 .52 .52 .52 .515 .51 .5 .5 ;
  10841. TT1.'I1DUNY' . 'K' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 3.5E3) 'K' ((PROG 92. 92. 91.3 89. 85.8 82.2 78.5 74.9 71.6 68.5 65.6 63 60.6 58.4 56.4 54.5 52.8 51.2 45. 35. 22. 51.)*P_COEF) ;
  10842. *
  10843. *
  10844. QUITTER BLOC1 ;
  10845. FINSI ;
  10846.  
  10847. ****************************************************************&*****
  10848. SI ( EGA MOT1 'N112X' ) ;
  10849. * Valeurs fournies par Deschamps le 12/02/93 a 20. et 1000. degres C
  10850. TT1.'N112X' = TABLE ;
  10851. *
  10852. TT1.'N112X' . 'K' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3) 'K'(PROG 210. 210. 125. 111. 80. 69. 51. 51.) ;
  10853. *
  10854. TT1.'N112X' . 'ALPH' = EVOL MANU 'T'(PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'ALPH' (PROG 2.7E-6 2.7E-6 2.9E-6 3.3E-6 4.0E-6 4.0E-6 );
  10855. QUITTER BLOC1 ;
  10856. FINSI ;
  10857. ***********************************************************************
  10858. SI ( EGA MOT1 'N112Y' ) ;
  10859. TT1.'N112Y' = TABLE ;
  10860. *
  10861. TT1.'N112Y' . 'K' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3) 'K'(PROG 200. 200. 120. 102. 76. 62. 49. 49.) ;
  10862. *
  10863. TT1.'N112Y' . 'ALPH' = EVOL MANU 'T'(PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'ALPH' (PROG 2.4E-6 2.4E-6 2.6E-6 3.0E-6 3.7E-6 3.7E-6 );
  10864. *
  10865. QUITTER BLOC1 ;
  10866. FINSI ;
  10867. SI ( EGA MOT1 'N112Z' ) ;
  10868. TT1.'N112Z' = TABLE ;
  10869. *
  10870. TT1.'N112Z' . 'K' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3) 'K'(PROG 174. 174. 92. 72. 60. 50. 45. 45.) ;
  10871. *
  10872. TT1.'N112Z' . 'ALPH' = EVOL MANU 'T'(PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'ALPH' (PROG 2.2E-6 2.2E-6 2.4E-6 2.8E-6 3.5E-6 3.5E-6 );
  10873. QUITTER BLOC1 ;
  10874. FINSI ;
  10875. ***********************************************************************
  10876. SI ( EGA MOT1 'N112P' ) ;
  10877. * donnees bonnal 19 avril 93
  10878. TT1.'N112P' = TABLE ;
  10879. TT1.'N112P' . 'K' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 5.5E3) 'K'(PROG 220.3 220.3 222.4 214.7 201. 186.9 173.4 161.3 150.7 141.3 133.1 125.9 119.6 114. 109. 104.6 100.6 97. 90. 70. 60. 58.) ;
  10880. *TITRE ' N112P SPECIF HEAT' ;
  10881. TT1.'N112P' . 'C' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 5.5E3) 'C' (PROG 669. 669. 770.3 935. 1063.2 1165.8 1249.7 1319.6 1378.8 1429.4 1473.4 1511.8 1545.7 1575.8 1602.7 1627.0 1648.9 1668.8 1748. 1950. 1950. 1950.) ;
  10882.  
  10883. *TITRE ' N112P DENSITY' ;
  10884. TT1.'N112P' . 'RHO' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 5.5E3) 'RHO' (PROG 2010. 2010. 2010. 2010. 2010. 2009. 2009. 2009. 2009. 2009. 2008. 2008. 2008. 2008. 2008. 2007. 2007. 2007. 2007. 2007. 2007. 2007. );
  10885.  
  10886. EVRHOC = (TT1.'N112P' . 'RHO') * ( TT1.'N112P' . 'C') ;
  10887. TT1.'N112P' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10888. QUITTER BLOC1 ;
  10889. FINSI ;
  10890. ***********************************************************************
  10891. SI ( EGA MOT1 'N112H' ) ;
  10892.  
  10893. TT1.'N112H' = TABLE ;
  10894. *
  10895. * TITRE ' N112 H CONDUCTIVITY' ;
  10896. TT1.'N112H' . 'K' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3) 'K'(PROG 210. 210. 123. 105. 76. 62. 52. 52.) ;
  10897. QUITTER BLOC1 ;
  10898. FINSI ;
  10899. ***********************************************************************
  10900. SI ( EGA MOT1 'N112' ) ;
  10901. TT1.'N112' = TABLE ;
  10902. *
  10903. TT1.'N112' . 'K' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3) 'K'(PROG 210. 210. 123. 105. 76. 62. 52. 52.) ;
  10904.  
  10905. *TITRE ' N112 SPECIF HEAT' ;
  10906. TT1.'N112' . 'C' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3) 'C' (PROG 780. 780. 1430. 1580. 1890. 2030. 2060. 2060.) ;
  10907.  
  10908. *TITRE ' N112 DENSITY' ;
  10909. TT1.'N112' . 'RHO' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3) 'RHO' (PROG 1820. 1820. 1820. 1820. 1820. 1820. 1820. 1820.);
  10910.  
  10911. EVRHOC = (TT1.'N112' . 'RHO') * ( TT1.'N112' . 'C') ;
  10912. TT1.'N112' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10913. * valeurs donnee par Deschamps 28 le 16.02.93
  10914. TT1.'N112' . 'YOUN' = EVOL MANU 'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'YOUN' (PROG 28.E9 28.E9 31.E9 34.E9 37.E9 37.E9);
  10915. *
  10916. QUITTER BLOC1 ;
  10917. FINSI ;
  10918. ***********************************************************************
  10919. SI ( EGA MOT1 'N11' ) ;
  10920. TT1.'N11' = TABLE ;
  10921. *
  10922. *js 190296 TT1.'N11' . 'K' = EVOL MANU
  10923. *js 190296 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3)
  10924. *js 190296 'K'(PROG 210. 210. 123. 105. 76. 62. 52. 52.) ;
  10925. TT1.'N11' . 'K' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.) 'K'((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1 165. 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 91.69 75.17 65.28 58.52 43.95) * ( 210./247.) );
  10926.  
  10927. *TITRE ' N11 SPECIF HEAT' ;
  10928. TT1.'N11' . 'C' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3) 'C' (PROG 780. 780. 1430. 1580. 1890. 2030. 2060. 2060.) ;
  10929.  
  10930. *TITRE ' N11 DENSITY' ;
  10931. TT1.'N11' . 'RHO' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3) 'RHO' (PROG 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720.);
  10932.  
  10933. EVRHOC = (TT1.'N11' . 'RHO') * ( TT1.'N11' . 'C') ;
  10934. TT1.'N11' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10935.  
  10936. * valeurs donnee par Deschamps 28 le 16.02.93
  10937. TT1.'N11' . 'YOUN' = EVOL MANU 'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'YOUN' (PROG 28.E9 28.E9 31.E9 34.E9 37.E9 37.E9);
  10938. *
  10939. QUITTER BLOC1 ;
  10940. FINSI ;
  10941.  
  10942. ***************************************************************************
  10943. SI ( EGA MOT1 'N11_PPI' ) ;
  10944. TT1.'N11_PPI' = TABLE ;
  10945.  
  10946. * ....Lipa...actualise les valeurs le 28.3.95..suivant mesures PPI.
  10947.  
  10948. TT1.'N11_PPI' . 'K' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3) 'K'(PROG 246. 246. 165. 141. 94. 72. 52. 52.) ;
  10949.  
  10950. *TITRE ' N11_PPI SPECIF HEAT' ;
  10951. TT1.'N11_PPI' . 'C' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3) 'C' (PROG 780. 780. 1430. 1580. 1890. 2030. 2060. 2060.) ;
  10952.  
  10953. *TITRE ' N11_PPI DENSITY' ;
  10954. TT1.'N11_PPI' . 'RHO' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3) 'RHO' (PROG 1750. 1750. 1750. 1750. 1750. 1750. 1750. 1750.);
  10955.  
  10956. EVRHOC = (TT1.'N11_PPI' . 'RHO') * ( TT1.'N11_PPI' . 'C') ;
  10957. TT1.'N11_PPI' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10958. * valeurs donnee par Deschamps 28 le 16.02.93
  10959.  
  10960. TT1.'N11_PPI' . 'YOUN' = EVOL MANU 'T' (PROG -500. 20. 500. 1000. 2000. 4.5E3 ) 'YOUN' (PROG 28.E9 28.E9 31.E9 34.E9 37.E9 37.E9);
  10961.  
  10962. TT1.'N11_PPI' . 'ALPH' = EVOL MANU 'T'(PROG -500. 20. 500. 1000. 2000. 4.5E3 ) 'ALPH' (PROG 1.5E-6 1.5E-6 1.6E-6 1.7E-6 1.8E-6 1.9E-6 );
  10963.  
  10964. TT1.'N11_PPI' . 'NU' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 3500.) 'NU' (PROG 0.4 0.4 0.4 0.4 0.4 0.4 0.4 );
  10965. *
  10966. QUITTER BLOC1 ;
  10967. FINSI ;
  10968. ***********************************************************************
  10969. SI ( EGA MOT1 'I1N112P' ) ;
  10970. * creation de ce materiau par J. SCHLOS le 22/09/94
  10971. * valeurs dans le plan, moyenne des directions x et y
  10972. * N112 // irradie at 640 deg C / 1.25 dpa.g
  10973. TT1.'I1N112P' = TABLE ;
  10974. *
  10975. TT1.'I1N112P' . 'K' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 3500.) 'K'((PROG 45.6 45.6 48.7 53.1 55.8 57.2 57.9 58. 57.8 57.4 56.8 56.1 55.4 54.7 54. 53.6 52.9 51.3 37.2 21. 11.3 6.2 1.9) );
  10976. * Source :Bonnal telecopie a Deschamps le 21 09 94
  10977. * extrapole au dessus de 600.
  10978.  
  10979. *TITRE ' I1N112P SPECIF HEAT' ;
  10980. TT1.'I1N112P' . 'C' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 3500.) 'C' ((PROG 666. 666. 750. 901. 1031. 1142. 1237. 1320. 1391.8 1455. 1511. 1561. 1605. 1645. 1651.4 1680.6 1707.1 1731.3 1865.8 2098.4 2281. 2433.4 2682.6 ) );
  10981.  
  10982.  
  10983. *TITRE ' I1N112P DENSITY' ;
  10984. TT1.'I1N112P' . 'RHO' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 3500. ) 'RHO' (PROG 2026. 2026. 2026. 2026. 2025. 2025. 2025. 2024. 2024. 2024. 2023. 2023. 2023. 2023. 2022. 2022. 2022. 2022. 2022. 2022. 2022. 2022. 2022.);
  10985. EVRHOC = (TT1.'I1N112P' . 'RHO') * ( TT1.'I1N112P' . 'C') ;
  10986. TT1.'I1N112P' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10987. QUITTER BLOC1 ;
  10988. FINSI ;
  10989. **************************************************************************************
  10990. SI ( EGA MOT1 'N11P' ) ;
  10991. * creation de ce materiau par R. MITTEAU le 20/01/94
  10992. * valeurs dans le plan, moyenne des directions x et y
  10993. * MODIF Fred.ESC. le 28/10/95 *****
  10994. * But de la manoeuvre :ameliorer la conductivite a haute temperature
  10995. * MODIF 1 : otpimisation au dela de 800 degC
  10996.  
  10997. TT1.'N11P' = TABLE ;
  10998. TT1.'N11P' . 'K' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.) 'K'((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1 165. 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 91.69 75.17 65.28 58.52 43.95) * ( 240./247.) );
  10999.  
  11000. *ESC 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 74.5 41.
  11001. *ESC 41. 41. 41.) * ( 240./247.) );
  11002.  
  11003. * MODIF 2 : MODIF 1 * ( 240./247.)
  11004. * 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 94.36 77.36
  11005. * 67.19 60.23 45.23) * ( 240./247.) );
  11006. * MODIF 3 : MODIF 2 * ( 1.05 )
  11007. * 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 99.08 81.23
  11008. * 70.54 63.25 47.5) * ( 240./247.) );
  11009. * MODIF 4 : ORIGINAL * ( 1.1 )
  11010. *153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 74.5 41.
  11011. * 41. 41. 41.) * ( 240./247.*1.1) );
  11012. * FIN MODIF Fred. ESC le 28/10/95 *****
  11013. * Source : Valeur a 25 C donnee par Chappuis selon mesures SEP
  11014. * (registre de controle individuel)2129043
  11015. * extrapolees pour les temperatures superieures selon valeurs
  11016. * du rapport DMT/93-265, J.P. BONAL, Elements pour la constitution
  11017. * d'une base de donnee sur les composites carbone-carboneA05 A035
  11018. * N11 N112 envisages pour la fusion thermonucleaire
  11019. * Aout 1993, extrapollee exponentiellement au dela de 800 C
  11020.  
  11021. *TITRE ' N11P SPECIF HEAT' ;
  11022. TT1.'N11P' . 'C' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.) 'C' (PROG 672.8 672.8 763.9 920.5 1049.4 1156.6 1247. 1324. 1390.4 1448.2 1498.8 1543.6 1583.5 1619.2 1651.4 1680.6 1707.1 1731.3 1865.8 2098.4 2281. 2433.4 2682.6 ) ;
  11023. * source: rapport DMT/93-265, J.P. BONAL, Elements pour la constitution
  11024. * d'une base de donnee sur les composites carbone-carboneA05 A035
  11025. * N11 N112 envisages pour la fusion thermonucleaire
  11026. * Aout 1993, extrapollee exponentiellement au dela de 800 C
  11027.  
  11028. *TITRE ' N11P DENSITY' ;
  11029. TT1.'N11P' . 'RHO' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500. ) 'RHO' (PROG 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720.);
  11030.  
  11031. EVRHOC = (TT1.'N11P' . 'RHO') * ( TT1.'N11P' . 'C') ;
  11032. TT1.'N11P' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11033.  
  11034. TT1.'N11P' . 'ALPH' = EVOL MANU 'T'(PROG 0. 20. 500. 1000. 2000. 9.5E3 ) 'ALPH' ((1.42/6.)*(PROG 6.E-6 6.E-6 6.6E-6 7.8E-6 9.E-6 9.0E-6 ));
  11035. * Source : Valeur a 20 C donnee par Chappuis selon mesures SEP
  11036. * extrapolees pour les temperatures superieures selon lois precedentes
  11037.  
  11038. TT1.'N11P' . 'YOUN' = EVOL MANU 'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'YOUN' ((24.5/22.)*(PROG 22.E9 22.E9 24.3E9 26.7E9 29.E9 29.E9));
  11039. * Source : Valeur a 20 C donnee par Chappuis selon mesures SEP
  11040. * extrapolees pour les temperatures superieures selon lois precedentes
  11041. *
  11042. TT1.'N11P' . 'NU' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 4000.) 'NU' (PROG 0.4 0.4 0.4 0.4 0.4 0.4 0.4 );
  11043. * Pris egal a celui de A05 par defaut d'autre valeur
  11044. QUITTER BLOC1 ;
  11045. FINSI ;
  11046. ***********************************************************************
  11047. SI ( EGA MOT1 'N11H' ) ;
  11048. * creation de ce materiau par R. MITTEAU le 20/01/94
  11049.  
  11050. TT1.'N11H' = TABLE ;
  11051. *
  11052. TT1.'N11H' . 'K' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.) 'K' ((PROG 170.1 170.1 168.1 159. 147.9 137.0 127.2 118.5 111. 104.5 98.9 94.1 89.9 86.2 82.9 80.1 77.6 75.3 56.3 32.3 18.6 10.7 3.5 ) * (149.4/170.1));
  11053. * Source : Valeur a 25 C donnee par Chappuis selon mesures SEP
  11054. * (registre de controle individuel) 2129043
  11055. * extrapolees pour les temperatures superieures selon valeurs
  11056. * du rapport DMT/93-265, J.P. BONAL, Elements pour la constitution
  11057. * d'une base de donnee sur les composites carbone-carbone A05 A035
  11058. * N11 N112 envisages pour la fusion thermonucleaire
  11059. * Aout 1993, extrapollee exponentiellement au dela de 800 C
  11060.  
  11061. *TITRE ' N11H SPECIF HEAT' ;
  11062. TT1.'N11H' . 'C' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500. ) 'C' (PROG 672.8 672.8 763.9 920.5 1049.4 1156.6 1247. 1324. 1390.4 1448.2 1498.8 1543.6 1583.5 1619.2 1651.4 1680.6 1707.1 1731.3 1865.8 2098.4 2281. 2433.4 2682.6 ) ;
  11063. * source rapport DMT/93-265, J.P. BONAL, Elements pour la constitution
  11064. * d'une base de donnee sur les composites carbone-carbone A05 A035
  11065. * N11 N112 envisages pour la fusion thermonucleaire
  11066. * Aout 1993, extrapollee y=a*(x**b) au dela de 800 C
  11067.  
  11068. *TITRE ' N11H DENSITY' ;
  11069. TT1.'N11H' . 'RHO' = EVOL MANU 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500. ) 'RHO' (PROG 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720.);
  11070.  
  11071. EVRHOC = (TT1.'N11H' . 'RHO') * ( TT1.'N11H' . 'C') ;
  11072. TT1.'N11H' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11073.  
  11074. TT1.'N11H' . 'ALPH' = EVOL MANU 'T'(PROG 0. 20. 500. 1000. 2000. 9.5E3 ) 'ALPH' ((PROG 6.E-6 6.E-6 6.6E-6 7.8E-6 9.E-6 9.0E-6 ) * (2.67/6));
  11075. * Source : Valeur a 25 C donnee par Chappuis selon mesures SEP
  11076. * (registre de controle individuel)2129043
  11077. * extrapolee en T suivant loi ?
  11078.  
  11079. TT1.'N11H' . 'YOUN' = EVOL MANU 'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'YOUN' (PROG 28.E9 28.E9 31.E9 34.E9 37.E9 37.E9);
  11080. * source : valeurs donnees par Deschamps le 16.02.93
  11081.  
  11082.  
  11083. TT1.'N11H' . 'NU' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 4000.) 'NU' (PROG 0.4 0.4 0.4 0.4 0.4 0.4 0.4 );
  11084. * Pris egal a celui de A05 par defaut d'autre valeur
  11085. QUITTER BLOC1 ;
  11086. FINSI ;
  11087. ***********************************************************************
  11088. SI ( EGA MOT1 '5890PT' ) ;
  11089. TT1.'5890PT' = TABLE ;
  11090. *
  11091. *TITRE ' 5890PT CONDUCTIVITY' ;
  11092. TT1.'5890PT' . 'K' = EVOL MANU 'T' (PROG -200. 27. 200. 600. 800. 1000. 1500. 2000. 9.5E3) 'K'( PROG 76. 76. 73.5 54.7 49.0 44.0 36.5 31.7 31.7);
  11093.  
  11094. TT1.'5890PT' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 9.5E3) 'RHO'(PROG 1820. 1820. 1820. 1820. 1820. 1820. 1820. );
  11095.  
  11096. TT1.'5890PT' . 'C' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 9.5E3) 'C'(PROG 880. 880. 1520. 1940. 2110. 2280. 2280.);
  11097.  
  11098. EVRHOC = (TT1.'5890PT' . 'RHO') * ( TT1.'5890PT' . 'C');
  11099.  
  11100. TT1.'5890PT' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11101. *
  11102. * caracteristiques mecaniques ajoutees par R. MITTEAU le 30 mars 1994
  11103.  
  11104. TT1.'5890PT' . 'YOUN' = EVOL MANU 'T' (PROG 0. 20. 200. 700. 1200. 1700. 2200. 9.5E3 ) 'YOUN' (PROG 12.E9 12.E9 13.E9 14.E9 15.E9 15.5E9 14.4E9 14.4E9);
  11105. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11106. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11107.  
  11108. TT1.'5890PT' . 'ALPH' = EVOL MANU 'T' (PROG 0. 20. 100. 700. 1200. 1700. 2200. 9.5E3 ) 'ALPH' (PROG 4.2E-6 4.2E-6 4.3E-6 4.8E-6 5.2E-6 5.6E-6 6.E-6 6.E-6);
  11109. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11110. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11111.  
  11112. TT1.'5890PT' . 'NU' = EVOL MANU 'T'(PROG 0. 20. 200. 700. 1200. 1700. 2200. 9.5E3 ) 'NU' (PROG .09 .09 .09 .1 .11 .12 .12 .12 );
  11113. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11114. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11115. QUITTER BLOC1 ;
  11116. FINSI ;
  11117. *********************************************************************
  11118. SI ( EGA MOT1 'PYRO_GP' ) ;
  11119. TT1.'PYRO_GP' = TABLE ;
  11120. *
  11121. *TITRE ' PYRO_GP CONDUCTIVITY' ;
  11122. TT1.'PYRO_GP' . 'K' = EVOL MANU 'T' (PROG -200. 27. 200. 400. 600. 800. 1000. 1200. 1400. 1600. 2000. 9.5E3) 'K'( PROG 500. 500. 408. 350. 294. 260. 238. 220. 203. 190. 190. 190. );
  11123.  
  11124. TT1.'PYRO_GP' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 9.5E3) 'RHO'(PROG 2200. 2200. 2200. 2200. 2200. 2200. 2200. );
  11125.  
  11126. TT1.'PYRO_GP' . 'C' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 9.5E3) 'C'(PROG 880. 880. 1520. 1940. 2110. 2280. 2280.);
  11127.  
  11128. EVRHOC = (TT1.'PYRO_GP' . 'RHO') * ( TT1.'PYRO_GP' . 'C');
  11129.  
  11130. TT1.'PYRO_GP' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11131. QUITTER BLOC1 ;
  11132. FINSI ;
  11133. **********************************************************************
  11134. SI ( EGA MOT1 'PYRO_GH' ) ;
  11135. *
  11136. TT1.'PYRO_GH' = TABLE ;
  11137. *
  11138. *TITRE ' PYRO_GH CONDUCTIVITY' ;
  11139. TT1.'PYRO_GH' . 'K' = EVOL MANU 'T' (PROG -200. 27. 200. 400. 600. 800. 1000. 1200. 1400. 1600. 2000. 9.5E3) 'K'( PROG 1. 1. 1. 1. 1. 1. 1. 1. 1. 1. 1. 1. );
  11140.  
  11141. TT1.'PYRO_GH' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 9.5E3) 'RHO'(PROG 2200. 2200. 2200. 2200. 2200. 2200. 2200. );
  11142.  
  11143. TT1.'PYRO_GH' . 'C' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 9.5E3) 'C'(PROG 880. 880. 1520. 1940. 2110. 2280. 2280.);
  11144.  
  11145. EVRHOC = (TT1.'PYRO_GP' . 'RHO') * ( TT1.'PYRO_GP' . 'C');
  11146.  
  11147. TT1.'PYRO_GH' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11148. *
  11149. QUITTER BLOC1 ;
  11150. FINSI ;
  11151. **********************************************************************
  11152. SI ( EGA MOT1 'TOYOTANSO' ) ;
  11153. TT1.'TOYOTANSO' = TABLE ;
  11154. *
  11155. LR1 = PROG 0. 20. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 4500. ;
  11156. LR2 = PROG 149.6 149.6 150.1 150.5 145.7 137.9 129.4 121.3 113.8 107.0 100.8 95.3 90.4 86.0 82.0 78.5 75.2 72.2 69.5 69.5 ;
  11157. *TITRE ' TOYOTANSO CONDUCTIVITY' ;
  11158. TT1.'TOYOTANSO' . 'K' = EVOL MANU 'T' LR1 'K' LR2 ;
  11159.  
  11160. LD = PROG 1838 1838 1838 1837 1836 1835 1833 1832 1831 1829 1828 1827 1825 1824 1823 1821 1820 1819 1817 1817 ;
  11161. TT1.'TOYOTANSO' . 'RHO' = EVOL MANU 'T' LR1 'RHO' LD ;
  11162.  
  11163. LR4 = PROG 666.8 666.8 686.4 778.0 933.3 1059.2 1162.9 1249.7 1323.3 1386.5 1441.2 1489.1 1531.4 1568.9 1602.5 1632.6 1659.9 1684.7 1707.3 1707.3 ;
  11164. TT1.'TOYOTANSO' . 'C' = EVOL MANU 'T' LR1 'C'LR4;
  11165.  
  11166. EVRHOC = (TT1.'TOYOTANSO' . 'RHO') * ( TT1.'TOYOTANSO' . 'C');
  11167.  
  11168. TT1.'TOYOTANSO' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11169. QUITTER BLOC1 ;
  11170. FINSI ;
  11171. **********************************************************************
  11172. SI ( EGA MOT1 'A05P' ) ;
  11173.  
  11174. TT1.'A05P' = TABLE ;
  11175.  
  11176. * 31/7/92 diminution de la conduc A05
  11177.  
  11178. *TITRE ' A05 // CONDUCTIVITY' ;
  11179. TT1.'A05P' . 'K' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 9.5E3) 'K'(PROG 200. 200. 117. 97. 68. 55. 45. 45.) ;
  11180.  
  11181. *
  11182. TT1.'A05P' . 'C' = EVOL MANU 'T' (PROG -5000. 20. 500. 1000. 2000. 9.5E3) 'C' ( PROG 880. 880. 1500. 1900. 2070. 2070.);
  11183.  
  11184. TT1.'A05P' . 'RHO' = EVOL MANU 'T' (PROG -5000. 20. 500. 1000. 2000. 9.5E3) 'RHO' (PROG 1770. 1770. 1770. 1770. 1770. 1770.);
  11185.  
  11186. EVRHOC = (TT1.'A05P' . 'RHO') * ( TT1.'A05P' . 'C');
  11187.  
  11188. TT1.'A05P' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11189.  
  11190. TT1.'A05P' . 'YOUN' = EVOL MANU 'T' (PROG 0. 20. 500. 1000. 2000. 9.5E3 ) 'YOUN' (PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9);
  11191.  
  11192. TT1.'A05P' . 'ALPH' = EVOL MANU 'T'(PROG 0. 20. 500. 1000. 2000. 9.5E3 ) 'ALPH' (PROG 1.E-6 1.E-6 1.1E-6 1.3E-6 1.5E-6 1.5E-6 );
  11193.  
  11194. TT1.'A05P' . 'NU' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 4000.) 'NU' (PROG 0.4 0.4 0.4 0.4 0.4 0.4 0.4 );
  11195. QUITTER BLOC1 ;
  11196. FINSI ;
  11197. **********************************************************************
  11198. SI ( EGA MOT1 'A05H' ) ;
  11199. TT1.'A05H' = TABLE ;
  11200. *
  11201. *TITRE ' A05 H CONDUCTIVITY' ;
  11202. TT1.'A05H' . 'K' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 9.5E3) 'K'(PROG 95. 95. 60. 47. 30. 28. 26. 26.) ;
  11203.  
  11204. * alpha pris egal a 6 * alpha de A05P le 3 decembre 1993
  11205. * R.MITTEAU - J. SCHLOSSER
  11206. TT1.'A05H' . 'ALPH' = EVOL MANU 'T'(PROG 0. 20. 500. 1000. 2000. 9.5E3 ) 'ALPH' (PROG 6.E-6 6.E-6 6.6E-6 7.8E-6 9.E-6 9.0E-6 );
  11207.  
  11208. * toutes evolutions suivantes de A05 H prises egales a celle
  11209. * de A05P le 3 decembre 1993 R.MITTEAU - J. SCHLOSSER
  11210. TT1.'A05H' . 'C' = EVOL MANU 'T' (PROG -5000. 20. 500. 1000. 2000. 9.5E3) 'C' ( PROG 880. 880. 1500. 1900. 2070. 2070.);
  11211.  
  11212. TT1.'A05H' . 'RHO' = EVOL MANU 'T' (PROG -5000. 20. 500. 1000. 2000. 9.5E3) 'RHO' (PROG 1770. 1770. 1770. 1770. 1770. 1770.);
  11213.  
  11214. EVRHOC = (TT1.'A05H' . 'RHO') * ( TT1.'A05H' . 'C');
  11215.  
  11216. TT1.'A05H' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11217.  
  11218.  
  11219. TT1.'A05H' . 'YOUN' = EVOL MANU 'T' (PROG 0. 20. 500. 1000. 2000. 9.5E3 ) 'YOUN' (PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9);
  11220.  
  11221. TT1.'A05H' . 'NU' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 4000.) 'NU' (PROG 0.4 0.4 0.4 0.4 0.4 0.4 0.4 );
  11222. QUITTER BLOC1 ;
  11223. FINSI ;
  11224. ********************************************************************************
  11225. SI ( EGA MOT1 'A05ORT3D' ) ;
  11226. * ce materiau est de l A05 orthotrope en 3 dimensions
  11227. * plans conducteurs dans la direction 2 - 3
  11228. * mis a jour le 22/12/93 par R. MITTEAU
  11229.  
  11230. TT1.'A05ORT3D' = TABLE ;
  11231.  
  11232. *------------------------ Donnees thermiques
  11233.  
  11234. TT1.'A05ORT3D' . 'K1' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 9.5E3) 'K'(PROG 95. 95. 60. 47. 30. 28. 26. 26.) ;
  11235. * ref : inconnue
  11236.  
  11237.  
  11238. TT1.'A05ORT3D' . 'K2' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3) 'K'(PROG 200. 200. 117. 97. 68. 55. 45. 45.) ;
  11239. * ref Le Carbone Lorraine
  11240.  
  11241. TT1.'A05ORT3D' . 'K3' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3) 'K'(PROG 200. 200. 117. 97. 68. 55. 45. 45.) ;
  11242. * reference Le Carbone Lorraine
  11243.  
  11244.  
  11245. TT1.'A05ORT3D' . 'C' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 2000. 4.5E3) 'C' ( PROG 880. 880. 1500. 1900. 2070. 2070.);
  11246. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11247.  
  11248.  
  11249. TT1.'A05ORT3D' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 2000. 4.5E3) 'RHO' (PROG 1770. 1770. 1770. 1770. 1770. 1770.);
  11250. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11251.  
  11252. EVRHOC = (TT1.'A05ORT3D' . 'RHO') * ( TT1.'A05ORT3D' . 'C');
  11253.  
  11254. TT1.'A05ORT3D' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11255.  
  11256. *------------------------ Donnees mecaniques
  11257.  
  11258. TT1.'A05ORT3D' . 'YG1' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 4000.) 'YOUN' (PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9 26.E9);
  11259. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11260.  
  11261. TT1.'A05ORT3D' . 'YG2' = EVOL MANU 'T' (PROG 0. 20. 300. 500. 700. 900. 4000.) 'YOUN' (PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9 26.E9) ;
  11262. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11263.  
  11264. TT1.'A05ORT3D' . 'YG3' = EVOL MANU 'T' (PROG 0. 20. 300. 500. 700. 900. 4000.) 'YOUN' (PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9 26.E9);
  11265. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11266.  
  11267. TT1.'A05ORT3D' . 'NU12' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 4000.) 'NU' (PROG 0.4 0.4 0.4 0.4 0.4 0.4 0.4 );
  11268. * ref : Le Carbone Lorraine, generalise pour toutes les T et directions
  11269.  
  11270. TT1.'A05ORT3D' . 'NU23' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 4000.) 'NU' (PROG 0.4 0.4 0.4 0.4 0.4 0.4 0.4 );
  11271. * ref : Le Carbone Lorraine, generalise pour toutes les T et directions
  11272.  
  11273. TT1.'A05ORT3D' . 'NU13' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 4000.) 'NU' (PROG 0.4 0.4 0.4 0.4 0.4 0.4 0.4 );
  11274. * ref : Le Carbone Lorraine, generalise pour toutes les T et directions
  11275.  
  11276.  
  11277. 1PLUS = EVOL MANU 'T' (PROG 0. 20. 300. 500. 700. 900. 4000.) 'NU' (PROG 1. 1. 1. 1. 1. 1. 1.);
  11278.  
  11279. TT1.'A05ORT3D' . 'G12' = TT1.'A05ORT3D' . 'YG3' /(2* (1PLUS + TT1.'A05ORT3D' . 'NU12' ));
  11280. * ref : formule G = E / (2 * (1 + nu)), a verifier en orthotrope
  11281.  
  11282. TT1.'A05ORT3D' . 'G23' = TT1.'A05ORT3D' . 'YG1' /(2* (1PLUS + TT1.'A05ORT3D' . 'NU23' ));
  11283. * ref : formule G = E / (2 * (1 + nu)), a verifier en orthotrope
  11284.  
  11285.  
  11286. TT1.'A05ORT3D' . 'G13' = TT1.'A05ORT3D' . 'YG2' /(2* (1PLUS + TT1.'A05ORT3D' . 'NU13' ));
  11287. * ref : formule G = E / (2 * (1 + nu)), a verifier en orthotrope
  11288.  
  11289.  
  11290. * TT1.'A05ORT3D' . 'G12' = EVOL MANU
  11291. *'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 )
  11292. * 'COULOMB' (1.6*(PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9));
  11293. * TT1.'A05ORT3D' . 'G23' = EVOL MANU
  11294. *'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 )
  11295. * 'COULOMB' (1.7*(PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9));
  11296. * TT1.'A05ORT3D' . 'G13' = EVOL MANU
  11297. *'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 )
  11298. * 'COULOMB' (1.8*(PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9));
  11299.  
  11300. TT1.'A05ORT3D' . 'ALP1' = EVOL MANU 'T'(PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'ALPH' (PROG 7.E-6 7.E-6 7.5E-6 8.0E-6 9.0E-6 10.0E-6 ) ;
  11301. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11302. * interpole a partir des valeurs a 20 C et 2000 C
  11303.  
  11304. TT1.'A05ORT3D' . 'ALP2' = EVOL MANU 'T'(PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'ALPH' (PROG 0.7E-6 0.7E-6 0.9E-6 1.1E-6 1.5E-6 2.3E-6 );
  11305. * interpole a partir des valeurs a 20 C et 2000 C
  11306. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11307.  
  11308. TT1.'A05ORT3D' . 'ALP3' = EVOL MANU 'T'(PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'ALPH' (PROG 0.7E-6 0.7E-6 0.9E-6 1.1E-6 1.5E-6 2.3E-6 );
  11309. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11310. * interpole a partir des valeurs a 20 C et 2000 C
  11311.  
  11312. QUITTER BLOC1 ;
  11313. FINSI ;
  11314. **********************************************************************
  11315.  
  11316. SI ( EGA MOT1 'A05ORT2D' ) ;
  11317. * ce materiau est de l A05 orthotrope en 2 dimensions
  11318. * plans conducteurs dans la direction
  11319. TT1.'A05ORT2D' = TABLE ;
  11320.  
  11321. *------------------------ Donnees thermiques
  11322.  
  11323. TT1.'A05ORT2D' . 'K' = EVOL MANU 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3) 'K'(PROG 200. 200. 117. 97. 68. 55. 45. 45.) ;
  11324.  
  11325.  
  11326. TT1.'A05ORT2D' . 'C' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 2000. 4.5E3) 'C' ( PROG 880. 880. 1500. 1900. 2070. 2070.);
  11327.  
  11328. TT1.'A05ORT2D' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 2000. 4.5E3) 'RHO' (PROG 1770. 1770. 1770. 1770. 1770. 1770.);
  11329.  
  11330. EVRHOC = (TT1.'A05ORT2D' . 'RHO') * ( TT1.'A05ORT2D' . 'C');
  11331.  
  11332. TT1.'A05ORT2D' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11333.  
  11334. *------------------------ Donnees mecaniques
  11335. * le 6/12/93, tout est bidon et ne sert qu a verifier
  11336. * que l orthotropie passe
  11337.  
  11338. TT1.'A05ORT2D' . 'YG1' = EVOL MANU 'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'YOUN' (PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9);
  11339.  
  11340. TT1.'A05ORT2D' . 'YG2' = EVOL MANU 'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'YOUN' (1.3*(PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9));
  11341.  
  11342. TT1.'A05ORT2D' . 'YG3' = EVOL MANU 'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'YOUN' (1.5*(PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9));
  11343.  
  11344.  
  11345. TT1.'A05ORT2D' . 'G12' = EVOL MANU 'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'COULOMB' (1.6*(PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9));
  11346.  
  11347. TT1.'A05ORT2D' . 'G23' = EVOL MANU 'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'COULOMB' (1.7*(PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9));
  11348.  
  11349. TT1.'A05ORT2D' . 'G13' = EVOL MANU 'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'COULOMB' (1.8*(PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9));
  11350.  
  11351. TT1.'A05ORT2D' . 'ALP1' = EVOL MANU 'T'(PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'ALPH' (PROG 1.E-6 1.E-6 1.1E-6 1.3E-6 1.5E-6 1.5E-6 );
  11352. *
  11353. TT1.'A05ORT2D' . 'ALP2' = EVOL MANU 'T'(PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'ALPH' (1.3*(PROG 1.E-6 1.E-6 1.1E-6 1.3E-6 1.5E-6 1.5E-6 ));
  11354.  
  11355. TT1.'A05ORT2D' . 'ALP3' = EVOL MANU 'T'(PROG 0. 20. 500. 1000. 2000. 4.5E3 ) 'ALPH' (1.5*(PROG 1.E-6 1.E-6 1.1E-6 1.3E-6 1.5E-6 1.5E-6 ));
  11356.  
  11357. TT1.'A05ORT2D' . 'NU12' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 4000.) 'NU' (PROG 0.4 0.4 0.4 0.4 0.4 0.4 0.4 );
  11358. *
  11359. TT1.'A05ORT2D' . 'NU23' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 4000.) 'NU' (PROG 0.4 0.4 0.4 0.4 0.4 0.4 0.4 );
  11360. *
  11361. TT1.'A05ORT2D' . 'NU13' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 4000.) 'NU' (PROG 0.4 0.4 0.4 0.4 0.4 0.4 0.4 );
  11362.  
  11363. QUITTER BLOC1 ;
  11364. FINSI ;
  11365. ******************************************************************************
  11366. SI ( EGA MOT1 'B4C' ) ;
  11367. TT1.'B4C' = TABLE ;
  11368.  
  11369. TT1.'B4C' . 'K' =EVOL MANU 'T' (PROG -200. 0. 50. 75. 100. 150. 200. 300. 400. 500. 600. 650. 700. 750. 1000. 2000. 2.5E3 ) 'K' (PROG 0.5 .5 1. 1.1 1.15 1.1 1. 0.8 0.78 0.87 1.12 1.4 1.75 2.2 4.45 13.45 18.);
  11370.  
  11371. * Valeurs rentrees le 30.01.1995 par R. Mitteau, d'apres le rapport
  11372. *'Determination de la conductivite thermique d'un depot de B4C sur
  11373. * un substrat cuivre' par D. Gosset, Rapport LEMA.DG.AD/95-003
  11374. * du 06.01.1995, valeurs extrapolees lineairement au dessus de 800C
  11375. * Valeurs representatives d'echantillons SNMI
  11376.  
  11377.  
  11378. TT1.'B4C' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 100. 200. 300. 400. 500. 600. 800. 1000. 1500. 2000. 2.5E3) 'RHO'(PROG 1.3E3 1.3E3 1.3E3 1.3E3 1.3E3 1.3E3 1.3E3 1.3E3 1.3E3 1.3E3 1.3E3 1.3E3 1.3E3 );
  11379.  
  11380. * Valeurs rentrees le 30.01.1995 par R. Mitteau, d'apres le rapport
  11381. *'Determination de la conductivite thermique d'un depot de B4C sur
  11382. * un substrat cuivre' par D. Gosset, Rapport LEMA.DG.AD/95-003
  11383. * du 06.01.1995, valeurs extrapolees lineairement au dessus de 800C
  11384. * Valeurs representatives d'echantillons SNMI
  11385.  
  11386.  
  11387. TT1.'B4C' . 'C' = EVOL MANU 'T' (PROG -200. 20. 100. 200. 300. 400. 500. 600. 800. 1000. 1500. 2000. 2.5E3) 'C' (PROG .5E3 .85E3 1.15E3 1.35E3 1.5E3 1.6E3 1.65E3 1.65E3 1.63E3 1.58E3 1.5E3 1.5E3 1.5E3) ;
  11388.  
  11389. * Valeurs rentrees le 30.01.1995 par R. Mitteau, d'apres le rapport
  11390. *'Determination de la conductivite thermique d'un depot de B4C sur
  11391. * un substrat cuivre' par D. Gosset, Rapport LEMA.DG.AD/95-003
  11392. * du 06.01.1995, valeurs extrapolees lineairement au dessus de 800C
  11393. * Valeurs representatives d'echantillons SNMI
  11394.  
  11395. EVRHOC = (TT1.'B4C' . 'RHO') * ( TT1.'B4C' . 'C');
  11396.  
  11397. TT1.'B4C' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11398.  
  11399.  
  11400. *
  11401. TT1.'B4C' . 'YOUN' = EVOL MANU 'T' (PROG 0. 20. 200. 400. 600. 2000.) 'YOUN' (PROG 450.E9 450.E9 450.E9 450.E9 450.E9 450.E9);
  11402.  
  11403. TT1.'B4C' . 'ALPH' = EVOL MANU 'T'(PROG 0. 20. 200. 400. 500. 600. 2000.) 'ALPH' (PROG 5.E-6 5.E-6 5.E-6 5.E-6 5.E-6 5.E-6 5.E-6 );
  11404.  
  11405. TT1.'B4C' . 'NU' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 2000.) 'NU' (PROG 0.3 0.3 0.3 0.3 0.3 0.3 0.3 );
  11406.  
  11407. * valeurs non connues prises identiques AU CUCRZR
  11408.  
  11409. TT1.'B4C' . 'SIGY' = EVOL MANU 'T'(PROG 0. 20. 200. 400. 500. 600. 800. 2000.) 'SIGY' (PROG 10.E6 10.E6 10.E6 10.E6 10.E6 10.E6 2.E6 0. );
  11410.  
  11411. * TT1.'B4C' . 'H' = EVOL MANU
  11412. *'T'(PROG 0. 20. 200. 400. 500. 600.
  11413. * 800. 1000.)
  11414. * 'H' (PROG 1190.5E6 1190.5E6 1041.7E6 875.E6 729.2E6 500.E6
  11415. * 312.5E6 10.E6 );
  11416. QUITTER BLOC1 ;
  11417. FINSI ;
  11418. **********************************************************************
  11419. SI ( EGA MOT1 'BEHP' ) ;
  11420. * stands for BEryllium Hot Pressed
  11421. * valeurs rentrees le 18 mars 1994 par raphael MITTEAU
  11422. TT1.'BEHP' = TABLE ;
  11423.  
  11424. TT1.'BEHP' . 'K' = EVOL MANU 'T' (PROG -200. 20. 100. 300. 500. 600. 800. 1000. 2000. 4000.) 'K'(PROG 187. 187. 149. 130. 108. 103. 99. 93. 77. 60. ) ;
  11425. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11426. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11427. * valeurs pour 20 300 500 600, Best Fit pour les autres (log)
  11428. * donnee en Watt/ metre * Kelvin
  11429.  
  11430. TT1.'BEHP' . 'ALPH' = EVOL MANU 'T'(PROG -200. 20. 100. 500. 1000. 4000. ) 'ALPH' (PROG 11.3E-6 11.3E-6 13.5E-6 19.E-6 22.7E-6 27.9E-6);
  11431. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11432. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11433. * valeurs pour 20 100 500 1000, Best Fit pour les autres (puiss)
  11434. * donnee en [.]
  11435.  
  11436. TT1.'BEHP' . 'C' = EVOL MANU 'T' (PROG -200. 20. 100. 500. 1000. 1500. 4000. ) 'C' (PROG 1700. 1700. 2090. 2250. 2920. 3590. 3590. );
  11437. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11438. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11439. * valeurs pour 20 100 500 1000 1500 C
  11440. * donnee en Joule par Kelvin et par Kilo
  11441. * ce jeu de valeurs montre sans doute un PB vers 100 C
  11442.  
  11443. TT1.'BEHP' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 100. 500. 1000. 1500. 4000. ) 'RHO' (PROG 1850. 1850. 1826. 1711. 1565. 1420. 1420. );
  11444. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11445. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11446. * valeurs pour 20 et 1500 C, linearise pour les autres valeurs
  11447. * donnee en Kilo par metre cube
  11448.  
  11449. EVRHOC = (TT1.'BEHP' . 'RHO') * ( TT1.'BEHP' . 'C');
  11450.  
  11451. TT1.'BEHP' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11452.  
  11453.  
  11454. TT1.'BEHP' . 'YOUN' = EVOL MANU 'T' (PROG -200. 20. 300. 500. 800. 4000. ) 'YOUN' (PROG 297.E9 297.E9 281.E9 270.E9 253.E9 72.E9 );
  11455. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11456. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11457. * valeurs pour 20 600 et 800 C, Best Fit pour les autres (lineaire)
  11458. * donnee Pascal
  11459.  
  11460.  
  11461. TT1.'BEHP' . 'NU' = EVOL MANU 'T'(PROG -200. 20. 300. 500. 700. 900. 4000. ) 'NU' (PROG .08 .08 .08 .08 .08 .08 .08 );
  11462. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11463. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11464.  
  11465.  
  11466. TT1.'BEHP' . 'SIGY' = EVOL MANU 'T'(PROG -200. 20. 200. 400. 600. 800. 1100. ) 'SIGY' (PROG 275.E6 275.E6 245.E6 210.E6 150.E6 25.E6 1.E6 );
  11467. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11468. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11469. * valeurs pour 20 a 800 C corrigees,
  11470. * extrapolees a vue au dessus en fonction de Temp Fusion
  11471. * donnees exprimees en Pascal
  11472.  
  11473. TT1.'BEHP' . 'H' = EVOL MANU 'T' (PROG 0. 20. 200. 400. 500. 600. 800. 4000.) 'H' (PROG 8. * 400.E6 );
  11474. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11475. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11476. * valeur moyenne prise cste pour tout T
  11477. * donnees exprimees en Pascal
  11478.  
  11479. QUITTER BLOC1 ;
  11480. FINSI ;
  11481. **********************************************************************
  11482. SI ( EGA MOT1 'BE_ITER' ) ;
  11483. * stands for BEryllium hot pressed and sintered, fitted values
  11484. * valeurs rentrees le 29 mars 95 par J.F. Salavy
  11485.  
  11486. * source : ITER MATERIAL PROPERTIES HANDBOOK
  11487. * (draft, file code ITER-AL01-2101)
  11488. * envoyees par Ivi Schmid le 29/03/95 (excepte pour H)
  11489. * Pour Young, Poisson et yield, les polynomes donnent des valeurs
  11490. * de 0 a 800C. Les valeurs suivantes sont intuitees mais
  11491. * non exactes.
  11492.  
  11493. TT1.'BE_ITER' = TABLE ;
  11494.  
  11495. LTEMC1 = (PROG 20. PAS 39. 800.) ;
  11496.  
  11497. LCON1 = PROG ;
  11498. LRHO1 = PROG ;
  11499. LCSP1 = PROG ;
  11500. LALP1 = PROG ;
  11501. LYOU1 = PROG ;
  11502. LPOI1 = PROG ;
  11503. LYIE1 = PROG ;
  11504.  
  11505. I1 = 0 ;
  11506. REPE BOUC1 (DIME LTEMC1) ;
  11507. I1 = I1 + 1 ;
  11508. TEMPC1 = EXTR LTEMC1 I1 ;
  11509. VALCON1 = (-1.0104E-07 * (TEMPC1 ** 3.)) + ( 2.5429E-04 * (TEMPC1 ** 2.)) + (-2.6939E-01 * TEMPC1 ) + ( 1.8980E+02 ) ;
  11510. LCON1 = LCON1 ET (PROG VALCON1) ;
  11511.  
  11512. VALCSP1 = ( 1.2748E-06 * (TEMPC1 ** 3.)) + (-3.1125E-03 * (TEMPC1 ** 2.)) + ( 3.3358E+00 * TEMPC1 ) + ( 1.7418E+03 ) ;
  11513. LCSP1 = LCSP1 ET (PROG VALCSP1) ;
  11514.  
  11515. VALRHO1 = (-1.5139E-05 * (TEMPC1 ** 2.)) + (-6.9336E-02 * TEMPC1 ) + ( 1.8230E+03 ) ;
  11516. LRHO1 = LRHO1 ET (PROG VALRHO1) ;
  11517.  
  11518. VALALP1 = ( 3.4457E-15 * (TEMPC1 ** 3.)) + (-1.3462E-11 * (TEMPC1 ** 2.)) + ( 2.1892E-08 * TEMPC1 ) + ( 1.0822E-05 ) ;
  11519. LALP1 = LALP1 ET (PROG VALALP1) ;
  11520.  
  11521. VALYOU1 = (-7.6042E+02 * (TEMPC1 ** 3.)) + ( 3.8393E+05 * (TEMPC1 ** 2.)) + (-8.6726E+07 * TEMPC1 ) + ( 3.0961E+11 ) ;
  11522. LYOU1 = LYOU1 ET (PROG VALYOU1) ;
  11523.  
  11524. VALPOI1 = (-2.5E-05 * TEMPC1 ) + ( 0.0715 ) ;
  11525. LPOI1 = LPOI1 ET (PROG VALPOI1) ;
  11526.  
  11527. VALYIE1 = ( 8.5157E-02 * (TEMPC1 ** 3.)) + (-4.1428E+02 * (TEMPC1 ** 2.)) + ( 4.4811E+04 * TEMPC1 ) + ( 2.2464E+08 ) ;
  11528. LYIE1 = LYIE1 ET (PROG VALYIE1) ;
  11529.  
  11530. FIN BOUC1 ;
  11531.  
  11532. LTEMPT = (PROG -200.) ET LTEMC1 ET (PROG 1250. 10000.) ;
  11533.  
  11534. LCON1T = (PROG (EXTR LCON1 1)) ET LCON1 ET (PROG 60. 60.) ;
  11535. LCSP1T = (PROG (EXTR LCSP1 1)) ET LCSP1 ET (PROG 3540. 3540.) ;
  11536. LRHO1T = (PROG (EXTR LRHO1 1)) ET LRHO1 ET (PROG 1713. 1713.) ;
  11537. LALP1T = (PROG (EXTR LALP1 1)) ET LALP1 ET (PROG 2.4E-5 2.4E-5) ;
  11538. LYOU1T = (PROG (EXTR LYOU1 1)) ET LYOU1 ET (PROG 98.E+9 98.E+9) ;
  11539. LPOI1T = (PROG (EXTR LPOI1 1)) ET LPOI1 ET (PROG 0.0517 0.0517) ;
  11540. LYIE1T = (PROG (EXTR LYIE1 1)) ET LYIE1 ET (PROG 35.E+6 35.E+6) ;
  11541.  
  11542.  
  11543. TT1.'BE_ITER' . 'K' = EVOL MANU 'T' (LTEMPT) 'K'(LCON1T) ;
  11544.  
  11545. TT1.'BE_ITER' . 'C' = EVOL MANU 'T' (LTEMPT) 'C' (LCSP1T) ;
  11546.  
  11547. TT1.'BE_ITER' . 'RHO' = EVOL MANU 'T' (LTEMPT) 'RHO' (LRHO1T) ;
  11548.  
  11549. TT1.'BE_ITER' . 'ALPH' = EVOL MANU 'T' (LTEMPT) 'ALPH' (LALP1T) ;
  11550.  
  11551. TT1.'BE_ITER' . 'YOUN' = EVOL MANU 'T' (LTEMPT) 'YOUN' (LYOU1T) ;
  11552.  
  11553. TT1.'BE_ITER' . 'NU' = EVOL MANU 'T' (LTEMPT) 'NU' (LPOI1T) ;
  11554.  
  11555. TT1.'BE_ITER' . 'SIGY' = EVOL MANU 'T' (LTEMPT) 'SIGY' (LYIE1T) ;
  11556.  
  11557.  
  11558. EVRHOC = (TT1.'BE_ITER' . 'RHO') * ( TT1.'BE_ITER' . 'C');
  11559.  
  11560. TT1.'BE_ITER' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11561.  
  11562.  
  11563. TT1.'BE_ITER' . 'H' = EVOL MANU 'T' (PROG 0. 20. 200. 400. 500. 600. 800. 4000.) 'H' (PROG 8. * 400.E6 );
  11564. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11565. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11566. * valeur moyenne prise cste pour tout T
  11567. * donnees exprimees en Pascal
  11568.  
  11569. QUITTER BLOC1 ;
  11570. FINSI ;
  11571.  
  11572. **********************************************************************
  11573. SI ( EGA MOT1 'MOLY' ) ;
  11574. TT1.'MOLY' = TABLE ;
  11575. *
  11576. TT1.'MOLY' . 'K' = EVOL MANU 'T' (PROG -100. 20. 500. 1000. 1500. 2000. 2500. 2.5E3 ) 'K'(PROG 60. 60. 50. 35. 22. 10. 2. 2. ) ;
  11577. *
  11578. QUITTER BLOC1 ;
  11579. FINSI ;
  11580. **********************************************************************
  11581. SI ( EGA MOT1 'TZM' ) ;
  11582. TT1.'TZM' = TABLE ;
  11583. *
  11584. TT1.'TZM'.'K' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 2500. 2.5E3 ) 'K'(PROG 125. 125. 115. 100. 87. 75. 67. 67. ) ;
  11585. TT1.'TZM' . 'C' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 2500. 2.5E3) 'C' ( PROG 240. 240. 250. 290. 330. 400. 500. 500. );
  11586.  
  11587. TT1.'TZM' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 2500. 2.5E3) 'RHO' (PROG 10200. 10200. 10200. 10200. 10200. 10200. 10200. 10200.);
  11588.  
  11589. EVRHOC = (TT1.'TZM'.'RHO') * ( TT1.'TZM'.'C');
  11590.  
  11591. TT1.'TZM' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11592.  
  11593. TT1.'TZM' . 'YOUN' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 2.5E3) 'YOUN' (PROG 300.E9 300.E9 260.E9 220.E9 140.E9 40.E9 40.E9);
  11594.  
  11595. TT1.'TZM' . 'ALPH' = EVOL MANU 'T'(PROG -200. 20. 500. 1000. 1500. 2000. 2500. 2.5E3 ) 'ALPH'(PROG 5.3E-6 5.3E-6 5.6E-6 6.0E-6 6.5E-6 7.2E-6 8.0E-6 8.0E-6 );
  11596.  
  11597. TT1.'TZM' . 'NU' = EVOL MANU 'T'(PROG -200. 20. 300. 500. 700. 900. 2000. 2.5E3) 'NU' (PROG 0.32 0.32 0.32 0.32 0.32 0.32 0.32 0.32 );
  11598.  
  11599. TT1.'TZM' . 'SIGY' = EVOL MANU 'T'(PROG -200. 20. 200. 400. 600. 800. 1000. 2.5E3 ) 'SIGY' (PROG 6.E8 6.E8 4.5E8 4.25E8 3.5E8 3.E8 2.5E8 2.5E8 );
  11600.  
  11601. TT1.'TZM' . 'H' = EVOL MANU 'T' (PROG -200. 20. 200. 400. 600. 800. 1000. 2.5E3 ) 'H' (PROG 1.1E9 1.1E9 1.1E9 1.1E9 1.1E9 1.1E9 1.1E9 1.1E9 );
  11602. *
  11603. QUITTER BLOC1 ;
  11604. FINSI ;
  11605. **********************************************************************
  11606. SI ( EGA MOT1 'TUNGSTEN' ) ;
  11607. TT1.'TUNGSTEN' = TABLE ;
  11608. *
  11609. TT1.'TUNGSTEN'.'K' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 2500. 3000. 3500. 4000. ) 'K'(PROG 130. 130. 120. 114. 105. 99. 95. 90. 85. 80.) ;
  11610. *Valeurs The NET TEAM, Valeurs de references ITER au dela
  11611.  
  11612. TT1.'TUNGSTEN' . 'C' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 2500. 3000. 3500. 4000.) 'C' ( PROG 140. 140. 150. 170. 180. 200. 220. 240. 260. 280. );
  11613. *Valeurs The NET TEAM, extrapolation lineaire au dela
  11614.  
  11615.  
  11616. TT1.'TUNGSTEN' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 2500. 3000. 3500. 4000.) 'RHO' (PROG 19200. 19200. 19200. 19200. 19200. 19200. 19200. 19200. 19200. 19200.);
  11617. *Valeurs The NET TEAM, extrapolation lineaire au dela
  11618.  
  11619. EVRHOC = (TT1.'TUNGSTEN'.'RHO') * ( TT1.'TUNGSTEN'.'C');
  11620.  
  11621. TT1.'TUNGSTEN' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11622. QUITTER BLOC1 ;
  11623. FINSI ;
  11624. **********************************************************************
  11625. SI ( EGA MOT1 'OFHC' ) ;
  11626. TT1.'OFHC' = TABLE ;
  11627. *
  11628. TT1.'OFHC' . 'K' = EVOL MANU 'T' (PROG -5000. 20. 200. 300. 400. 600. 800. 1000. 2.5E3 ) 'K'(PROG 387. 387. 365. 351.5 338. 312. 291. 273. 273. ) ;
  11629. * 'T' (PROG -500. 20. 200. 300. 400. 600. 2.5E3 )
  11630. * 'K'(PROG 387. 387. 365. 351.5 338. 312. 312.) ;
  11631. *
  11632.  
  11633. TT1.'OFHC' . 'C' = EVOL MANU 'T' (PROG -5000. 20. 200. 400. 600. 2.5E3) 'C'( PROG 380. 380. 390. 400. 415. 415.);
  11634.  
  11635. TT1.'OFHC' . 'RHO' = EVOL MANU 'T' (PROG -5000. 20. 200. 400. 600. 2.5E3) 'RHO'(PROG 8750. 8750. 8650. 8560. 8480. 8480.);
  11636.  
  11637. EVRHOC = (TT1.'OFHC' . 'RHO') * ( TT1.'OFHC' . 'C');
  11638.  
  11639. TT1.'OFHC' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11640.  
  11641. TT1.'OFHC' . 'YOUN' = EVOL MANU 'T' (PROG 0. 20. 200. 400. 600. 2000.) 'YOUN' (PROG 132.E9 132.E9 120.E9 103.E9 90.E9 29.E9);
  11642.  
  11643. TT1.'OFHC' . 'ALPH' = EVOL MANU 'T' (PROG 0. 20. 200. 400. 500. 600. 2000.) 'ALPH' (PROG 16.6E-6 16.7E-6 17.3E-6 18.1E-6 18.45E-6 18.7E-6 20.0E-6 );
  11644.  
  11645. TT1.'OFHC' . 'NU' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 2000.) 'NU' (PROG 0.3 0.3 0.3 0.3 0.3 0.3 0.3 );
  11646.  
  11647. TT1.'OFHC' . 'SIGY' = EVOL MANU 'T'(PROG 0. 20. 200. 400. 500. 600. 800. 2000.) 'SIGY' (PROG 60.E6 60.E6 40.E6 20.E6 15.E6 10.E6 2.E6 0. );
  11648.  
  11649. TT1.'OFHC' . 'H' = EVOL MANU 'T' (PROG 0. 20. 200. 400. 500. 600. 800. 1000.) 'H' (PROG 1190.5E6 1190.5E6 1041.7E6 875.E6 729.2E6 500.E6 312.5E6 10.E6 );
  11650. QUITTER BLOC1 ;
  11651. FINSI ;
  11652. **********************************************************************
  11653. SI ( EGA MOT1 'OFHCCYCL' ) ;
  11654. *
  11655. * Materiau entre le 19 septembre 1995 par R. Mitteau
  11656. *
  11657. * designation : Cuivre OFHC, proprietes mecaniques correspondant
  11658. * aux courbes d'ecrouissage cyclique
  11659. *
  11660. * Conductivite, rho, capacite calorifiques
  11661. * coefficient de Poisson prises identiques a OFHC
  11662. *
  11663. * Module d'young, SIGY et H d'apres
  11664. *
  11665. * High Temperature Torsional Low Cycle Fatigue of OFHC Copper
  11666. * Ahmet Aran and Dogan Erdun Gucer, Material Research Division,
  11667. * Marmara Research Institute...
  11668. * in Z. Metallkunde
  11669. *
  11670. * retravaille suivant CFP ...
  11671. *
  11672. *
  11673. *
  11674. TT1.'OFHCCYCL' = TABLE ;
  11675. *
  11676. TT1.'OFHCCYCL' . 'K' = EVOL MANU 'T' (PROG -5000. 20. 200. 300. 400. 600. 800. 1000. 2.5E3 ) 'K'(PROG 387. 387. 365. 351.5 338. 312. 291. 273. 273. ) ;
  11677.  
  11678. TT1.'OFHCCYCL' . 'C' = EVOL MANU 'T' (PROG -5000. 20. 200. 400. 600. 2.5E3) 'C'( PROG 380. 380. 390. 400. 415. 415.);
  11679.  
  11680. TT1.'OFHCCYCL' . 'RHO' = EVOL MANU 'T' (PROG -5000. 20. 200. 400. 600. 2.5E3) 'RHO'(PROG 8750. 8750. 8650. 8560. 8480. 8480.);
  11681.  
  11682. EVRHOC = (TT1.'OFHCCYCL' . 'RHO') * ( TT1.'OFHCCYCL' . 'C');
  11683.  
  11684. TT1.'OFHCCYCL' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11685.  
  11686. TT1.'OFHCCYCL' . 'YOUN' = EVOL MANU 'T' (PROG -150. 20. 100. 200. 300. 400. 450. 500. 600.) 'YOUN' (1.E9*(PROG 5. 5. 5. 5. 4.6 4. 2.5 1.2 .5 ));
  11687.  
  11688. TT1.'OFHCCYCL' . 'ALPH' = EVOL MANU 'T' (PROG 0. 20. 200. 400. 500. 600. 2000.) 'ALPH' (PROG 16.6E-6 16.7E-6 17.3E-6 18.1E-6 18.45E-6 18.7E-6 20.0E-6 );
  11689.  
  11690. TT1.'OFHCCYCL' . 'NU' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 2000.) 'NU' (PROG 0.3 0.3 0.3 0.3 0.3 0.3 0.3 );
  11691.  
  11692. TT1.'OFHCCYCL' . 'SIGY' = EVOL MANU 'T'(PROG -150. 20. 100. 200. 300. 400. 450. 500. 600.) 'SIGY' (1.E6 *(PROG 116. 116. 112. 100. 86. 65. 33. 14. 5. ));
  11693.  
  11694. TT1.'OFHCCYCL' . 'H' = EVOL MANU 'T' (PROG -150. 20. 100. 200. 300. 400. 450. 500. 600. ) 'H' (1.E6 *(PROG 190. 190. 176. 154. 132. 110. 86. 62. 16. ));
  11695. QUITTER BLOC1 ;
  11696. FINSI ;
  11697. **********************************************************************
  11698. SI ( EGA MOT1 'INOX316L' ) ;
  11699. TT1.'INOX316L' = TABLE ;
  11700. *
  11701. TT1.'INOX316L' . 'K' = EVOL MANU 'T' (PROG -200. 20. 500. 800. 1000. 4.5E3 ) 'K'(PROG 15. 15. 21. 26. 28. 28.) ;
  11702.  
  11703. TT1.'INOX316L' . 'C' = EVOL MANU 'T' (PROG -200. 20. 500. 800. 1000. 2.5E3) 'C' ( PROG 480. 480. 560. 610. 650. 650.);
  11704.  
  11705. TT1.'INOX316L' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 500. 800. 1000. 2.5E3) 'RHO' (PROG 7850. 7850. 7850. 7850. 7850. 7850. );
  11706.  
  11707. EVRHOC = (TT1.'INOX316L' . 'RHO') * ( TT1.'INOX316L' . 'C');
  11708.  
  11709. TT1.'INOX316L' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11710.  
  11711. TT1.'INOX316L' . 'YOUN' = EVOL MANU 'T' (PROG 0. 20. 300. 500. 650. 2000. ) 'YOUN' (PROG 190.E9 190.E9 170.E9 155.E9 145.E9 145.E9 );
  11712.  
  11713. TT1.'INOX316L' . 'ALPH' = EVOL MANU 'T'(PROG 0. 20. 400. 500. 700. 2000.) 'ALPH' (PROG 16.2E-6 16.2E-6 17.8E-6 18.1E-6 18.7E-6 20.5E-6 );
  11714.  
  11715. TT1.'INOX316L' . 'NU' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 2000.) 'NU' (PROG 0.3 0.3 0.3 0.3 0.3 0.3 0.3 );
  11716.  
  11717. TT1.'INOX316L' . 'SIGY' = EVOL MANU *'T'(PROG 0. 20. 300. 500. 700. 2000. ) * 'SIGY' (PROG 250.E6 250.E6 160.E6 140.E6 120.E6 120.E6 );
  11718. 'T'(PROG 0. 20. 100. 200. 300. 400. 500. 600. 900. 2000. ) 'SIGY' (PROG 200.E6 200.E6 165.E6 132.5E6 112.5E6 100.E6 93.8E6 85.E6 65.E6 65.E6);
  11719. TT1.'INOX316L' . 'H' = EVOL MANU 'T'(PROG 0. 20. 100. 200. 300. 400. 500. 600. 900. 2000. ) 'H' (PROG 10.E9 10.E9 8.25E9 7.0E9 6.E9 4.5E9 4.5E9 4.5E9 4.5E9 4.5E9 );
  11720. QUITTER BLOC1 ;
  11721. FINSI ;
  11722. **********************************************************************
  11723. SI ( EGA MOT1 'GLIDCOP' ) ;
  11724. TT1.'GLIDCOP' = TABLE ;
  11725. *
  11726. TT1.'GLIDCOP' . 'K' = EVOL MANU 'T' (PROG -5000. 20. 200. 300. 500. 2.5E3 ) 'K'(PROG 348. 348. 325. 310.0 290. 290.) ;
  11727. * 'K'(PROG 391. 391. 385. 381. 377. 338. 312.) ;
  11728.  
  11729. TT1.'GLIDCOP' . 'C' = EVOL MANU 'T' (PROG -5000. 20. 200. 300. 400. 500. 600. 2.5E3) 'C' ( PROG 380. 380. 400. 410. 413. 413. 413. 413.);
  11730.  
  11731. TT1.'GLIDCOP' . 'RHO' = EVOL MANU 'T' (PROG -5000. 20. 200. 300. 400. 500. 600. 2.5E3) 'RHO' (PROG 8860. 8860. 8760. 8715. 8670. 8630. 8590. 8590.);
  11732.  
  11733. EVRHOC = (TT1.'GLIDCOP' . 'RHO') * ( TT1.'GLIDCOP' . 'C');
  11734.  
  11735. TT1.'GLIDCOP' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11736.  
  11737. TT1.'GLIDCOP' . 'YOUN' = EVOL MANU 'T' (PROG 0. 20. 200. 500. 800. 2000.) 'YOUN' (PROG 130.E9 130.E9 120.E9 98.E9 75.E9 75.E9);
  11738.  
  11739. TT1.'GLIDCOP' . 'ALPH' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 2000.) 'ALPH' (PROG 17.E-6 17.E-6 17.5E-6 18.5E-6 19.5E-6 19.5E-6 );
  11740.  
  11741. TT1.'GLIDCOP' . 'NU' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 2000.) 'NU' (PROG 0.3 0.3 0.3 0.3 0.3 0.3 0.3 );
  11742.  
  11743. TT1.'GLIDCOP' . 'SIGY' = EVOL MANU 'T'(PROG 0. 20. 200. 300. 500. 2000. ) 'SIGY' (PROG 424.E6 424.E6 313.E6 259.E6 169.E6 169.E6 );
  11744. * VALeurs prises egales au OFHC a controler
  11745.  
  11746. TT1.'GLIDCOP' . 'H' = EVOL MANU 'T'(PROG 0. 20. 200. 400. 500. 600. 800. 1000.) 'H' (PROG 1190.5E6 1190.5E6 1041.7E6 875.E6 729.2E6 500.E6 312.5E6 10.E6 );
  11747. QUITTER BLOC1 ;
  11748. FINSI ;
  11749. **********************************************************************
  11750. SI ( EGA MOT1 'OUTOKUMPU' ) ;
  11751. ***********************************************************************
  11752. TT1.'OUTOKUMPU' = TABLE ;
  11753. *
  11754. * seul valeur connue a 20 deg le reste pris proportionnellement a OFHC
  11755. TT1.'OUTOKUMPU' . 'K' = EVOL MANU 'T' (PROG -500. 20. 200. 300. 400. 600. 2.5E3 ) 'K'(PROG 355. 355. 335. 322.4 310. 286. 286.) ;
  11756. *OFHC
  11757. * 'T' (PROG -500. 20. 200. 300. 400. 600. 2.5E3 )
  11758. * 'K'(PROG 387. 387. 365. 351.5 338. 312. 312.) ;
  11759. QUITTER BLOC1 ;
  11760. FINSI ;
  11761. **********************************************************************
  11762. SI ( EGA MOT1 'CUCRZR' ) ;
  11763. TT1.'CUCRZR' = TABLE ;
  11764. *
  11765. *TITRE 'CUCRZR CONDUCTIVITY' ;
  11766. TT1.'CUCRZR' . 'K' = EVOL MANU 'T' (PROG -500. 20. 200. 300. 400. 600. 2.5E3 ) 'K'(PROG 343. 343. 351. 359. 359. 359. 312.) ;
  11767. TT1.'CUCRZR' . 'C' = EVOL MANU 'T' (PROG -200. 20. 200. 400. 600. 2.5E3) 'C' ( PROG 376. 376. 376. 376. 376. 376.);
  11768.  
  11769. TT1.'CUCRZR' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 200. 400. 600. 2.5E3) 'RHO'(PROG 8890. 8890. 8890. 8890. 8890. 8890.);
  11770.  
  11771. EVRHOC = (TT1.'CUCRZR' . 'RHO') * ( TT1.'CUCRZR' . 'C');
  11772.  
  11773. TT1.'CUCRZR' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11774.  
  11775. * valeurs non connues prises identiques CU dependent de l'etat du metal
  11776. TT1.'CUCRZR' . 'YOUN' = EVOL MANU 'T' (PROG 0. 20. 200. 400. 600. 2000.) 'YOUN' (PROG 132.E9 132.E9 120.E9 103.E9 90.E9 29.E9);
  11777.  
  11778. TT1.'CUCRZR' . 'ALPH' = EVOL MANU 'T'(PROG 0. 20. 200. 400. 500. 600. 800. 1000. 2000.) 'ALPH' (PROG 16.6E-6 16.7E-6 17.3E-6 18.1E-6 18.45E-6 18.7E-6 19.1E-6 19.5E-6 20.0E-6);
  11779.  
  11780. TT1.'CUCRZR' . 'NU' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 2000.) 'NU' (PROG 0.3 0.3 0.3 0.3 0.3 0.3 0.3 );
  11781.  
  11782. TT1.'CUCRZR' . 'SIGY' = EVOL MANU 'T'(PROG 0. 20. 200. 400. 500. 600. 800. 2000.) 'SIGY' (PROG 210.E6 210.E6 200.E6 140.E6 100.E6 10.E6 2.E6 0. );
  11783.  
  11784. TT1.'CUCRZR' . 'H' = EVOL MANU 'T'(PROG 0. 20. 200. 400. 500. 600. 800. 1000.) 'H' (PROG 1190.5E6 1190.5E6 1041.7E6 875.E6 729.2E6 500.E6 312.5E6 10.E6 );
  11785. *
  11786. QUITTER BLOC1 ;
  11787. FINSI ;
  11788. **********************************************************************
  11789. SI ( EGA MOT1 'CUZR' ) ;
  11790. TT1.'CUZR' = TABLE ;
  11791. *valeurs non connues prises -10% au OFHC
  11792.  
  11793. TT1.'CUZR' . 'K' =EVOL MANU 'T' (PROG -200. 20. 200. 600. 1200. 2500. 2.5E3 ) 'K' (PROG 335. 335. 314. 270. 270. 270. 270.);
  11794.  
  11795. * valeurs non connues prises identiques au OFHC
  11796. TT1.'CUZR' . 'C' = EVOL MANU 'T' (PROG -200. 20. 200. 400. 600. 2.5E3) 'C'( PROG 380. 380. 390. 400. 415. 415.);
  11797.  
  11798. TT1.'CUZR' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 200. 400. 600. 2.5E3) 'RHO'(PROG 8750. 8750. 8650. 8560. 8480. 8480.);
  11799.  
  11800. EVRHOC = (TT1.'CUZR' . 'RHO') * ( TT1.'CUZR' . 'C');
  11801.  
  11802. TT1.'CUZR' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11803. * valeurs non connues prises identiques AU CU
  11804. TT1.'CUZR' . 'YOUN' = EVOL MANU 'T' (PROG 0. 20. 200. 400. 600. 2000.) 'YOUN' (PROG 132.E9 132.E9 120.E9 103.E9 90.E9 29.E9);
  11805.  
  11806. TT1.'CUZR' . 'ALPH' = EVOL MANU 'T'(PROG 0. 20. 200. 400. 500. 600. 2000.) 'ALPH' (PROG 16.6E-6 16.7E-6 17.3E-6 18.1E-6 18.45E-6 18.7E-6 20.0E-6);
  11807.  
  11808. TT1.'CUZR' . 'NU' = EVOL MANU 'T'(PROG 0. 20. 300. 500. 700. 900. 2000.) 'NU' (PROG 0.3 0.3 0.3 0.3 0.3 0.3 0.3 );
  11809.  
  11810. * valeurs non connues prises identiques AU CUCRZR
  11811.  
  11812. TT1.'CUZR' . 'SIGY' = EVOL MANU 'T'(PROG 0. 20. 200. 400. 500. 600. 800. 2000.) 'SIGY' (PROG 210.E6 210.E6 200.E6 140.E6 100.E6 10.E6 2.E6 0. );
  11813.  
  11814. TT1.'CUZR' . 'H' = EVOL MANU 'T'(PROG 0. 20. 200. 400. 500. 600. 800. 1000.) 'H' (PROG 1190.5E6 1190.5E6 1041.7E6 875.E6 729.2E6 500.E6 312.5E6 10.E6 );
  11815. QUITTER BLOC1 ;
  11816. FINSI ;
  11817. **********************************************************************
  11818. SI ( EGA MOT1 'AL25' ) ;
  11819. TT1.'AL25' = TABLE ;
  11820. *
  11821. *TITRE ' AL25 CONDUCTIVITY' ;
  11822. TT1.'AL25'. 'K' = EVOL MANU 'T' (PROG -500. 20. 100. 200. 300. 400. 600. 2.5E3 ) 'K'(PROG 350. 350. 340. 327. 317. 300. 280. 280.) ;
  11823. QUITTER BLOC1 ;
  11824. FINSI ;
  11825. **********************************************************************
  11826. FIN BLOC1 ;
  11827. **********************************************************************
  11828. *
  11829. * Fin de la table de materiaux standarts
  11830. *
  11831. * Debut de la partie de la procedure qui retourne les donnees
  11832. *
  11833. **********************************************************************
  11834.  
  11835. SI (EXISTE TABT MOT1 ) ;
  11836. SI ( EXISTE (TABT. MOT1) MOT2 ) ;
  11837. EV1 = TABT . MOT1 . MOT2 ;
  11838. SINON ;
  11839. SI ( EXISTE TT1 MOT1 ) ;
  11840. SI ( EXISTE (TT1. MOT1) MOT2 ) ;
  11841. EV1 = TT1 . MOT1 . MOT2 ;
  11842. SINON ;
  11843. MESS '>>> Material ' MOT1 ' exists by you and in standard' ;
  11844. MESS '>>> the property ' MOT2 ' of the material ' MOT1 ' is not defined in your data' ' nor is it in satandard' ;
  11845. MESS '>>> Execution break-down by lack of data ' ;
  11846. ERRE 'MATERIAL' ;
  11847. FINSI ;
  11848. SINON ;
  11849. MESS '>>> MAT ' MOT1 ' exists by you but not in standard' ;
  11850. MESS '>>> the property ' MOT2 ' of the material ' MOT1 ' is not defined in your data' ;
  11851. MESS '>>> Execution break-down by lack of data ' ;
  11852. ERRE ' MATERIAL' ;
  11853. FINSI ;
  11854. FINSI ;
  11855. SINON ;
  11856. SI ( EXISTE TT1 MOT1 ) ;
  11857. SI ( EXISTE (TT1. MOT1) MOT2 ) ;
  11858. EV1 = TT1 . MOT1 . MOT2 ;
  11859. SINON ;
  11860. MESS '>>> The property ' MOT2 ' of the material ' MOT1 ' is not defined in standard' ;
  11861. ERRE 'MATERIAL' ;
  11862. FINSI ;
  11863. SINON ;
  11864. MESS '>>>> The material ' MOT1 ' is not defined in standard' ;
  11865. ERRE 'MATERIAL' ;
  11866. FINSI ;
  11867. FINSI ;
  11868.  
  11869. SI ( EXISTE VAL1 ) ;
  11870. EV1 = IPOL VAL1 (EXTR EV1 'ABSC' ) (EXTR EV1 'ORDO') ;
  11871. FINSI ;
  11872.  
  11873. SI ( EXISTE CHP1 ) ;
  11874. EV1 = IPOL CHP1 (EXTR EV1 'ABSC' ) (EXTR EV1 'ORDO') ;
  11875. FINSI ;
  11876. *
  11877. *
  11878. * Organisation :
  11879. * --------------
  11880. *
  11881. * La procedure est organisee en deux parties.
  11882. *
  11883. * La premiere partie est une table standart contenant les
  11884. * caracteristiques des materiaux usuels du groupe premiere paroi.
  11885. * Les donnees sont regroupes dans le bloc BLOC1.
  11886. *
  11887. * d'abord : materiaux de surface
  11888. * puis : materiaux intercalaires
  11889. * enfin : materiaux de structure
  11890. *
  11891. *
  11892.  
  11893. * Afin de ne pas surcharger la memoire de choses inutiles, un test
  11894. * permet de ne lire les donnees du materiau que s'il est effectivement
  11895. * appelle.
  11896. * Des que le materiau a ete lu, on sort du bloc, car il n'est pas
  11897. * necessaire de passer par tout les tests qui seront negatifs.
  11898. *
  11899. * Les caracteristiques sont definies sous forme d'evolutions.
  11900. *
  11901. * La deuxieme partie est la procedure proprement dite.
  11902. * Elle est organisee sous forme de tests SI-SINON-FINSI.
  11903.  
  11904. *-------------------------------------------------------------------*
  11905. FINPROC EV1 ;
  11906.  
  11907.  
  11908. 'DEBPROC' TELIGNSC MAIL_1*MAILLAGE CHP_1*CHPOINT P_DEB*POINT P_FIN*POINT CRIT*FLOTTANT ;
  11909. ********************************************************
  11910. *
  11911. * CETTE PROC. PERMET de reduire les valeurs du chpoint
  11912. *CHP_1 aux points les plus proche de la droite P_DEB P_FIN
  11913. * les points sont reperes suivant la distance a P_DEB
  11914. *la proc. rend une evolution donnant la valeur
  11915. *en fonction de la distance
  11916. *
  11917. * j. schlosser 8 4 92
  11918. *
  11919. ********************************************************
  11920. LBRI1 = MAIL_1 POIN 'DROIT' P_DEB P_FIN CRIT ;
  11921. i1 = 0 ;
  11922. opti elem seg2 ;
  11923. repeter bou4 (( NBNO LBRI1) - 1 ) ;
  11924. i1 = i1 + 1 ;
  11925. po1 = LBRI1 poin i1 ;
  11926. po2 = LBRI1 poin ( i1 + 1 ) ;
  11927. si ( i1 ega 1 ) ;
  11928. lbri2 = po1 d 1 po2 ;
  11929. sinon ;
  11930. lbri2 = lbri2 d 1 po2 ;
  11931. finsi ;
  11932. fin bou4 ;
  11933. XLBRI1 = COOR 1 LBRI2 ;
  11934. YLBRI1 = COOR 2 LBRI2 ;
  11935. NI1 = ( (( XLBRI1 - ( COOR 1 P_DEB )) ** 2 ) + (( YLBRI1 - ( COOR 2 P_DEB )) ** 2 ) ) ** 0.5 ;
  11936. EVI1 = evol chpo (REDU CHP_1 LBRI2 ) scal LBRI2 ;
  11937. EVI2 = evol chpo NI1 scal LBRI2 ;
  11938. EVIT1 = evol manu (EVI2 extr 'ORDO' 1 ) (EVI1 extr 'ORDO'1 ) ;
  11939. dess ( evI1 et evI2 ) ;
  11940. FINPROC EVIT1 ;
  11941.  
  11942. *EVIT1 = TELIGNSC VBRIQT CHT1 P01 O67 1.E-3 ;
  11943. **** @FLNORM
  11944.  
  11945. DEBPROC @FLNORM TAB1*TABLE ;
  11946. *
  11947. **************************************************
  11948. * Procedure (inspiree de @OMBRAGE) permettant de *
  11949. * recuperer les valeurs du flux normalise en *
  11950. * descendant les lignes de champ et en calculant *
  11951. * leur intersection avec le plan sur lequel la *
  11952. * valeur du flux normalise est connue. *
  11953. * Alain MOAL (Fevrier 2001) *
  11954. **************************************************
  11955. *
  11956. MESS '---------------------------------> calling @FLNORM';
  11957. *
  11958. *--------------- VARIABLES D'ENTREE :
  11959. MAIL1 = TAB1.LFLUX_EXTE ;
  11960. MAIL2 = TAB1.<MAILLAGE_FN ;
  11961. PASB1 = TAB1.<LONGUEUR_PAS_SANS_TEST ;
  11962. PASB2 = TAB1.<LONGUEUR_PAS_AVEC_TEST ;
  11963. *------------------------------------
  11964. *
  11965. *---- Champ magnetique sur le maillage "ombre"
  11966. TAB1.<MAILLAGE_B = MAIL1 ;
  11967. BR BZ BPHI = @MAGNB TAB1 ;
  11968. *
  11969. *---- signe pour descente de la ligne (+ si bz < 0)
  11970. TAB1.<CHAMP_SIGNE = BZ * (-1.) / (ABS BZ) ;
  11971. *
  11972. *---- distance a parcourir sans test d'intersection
  11973. CHZ = COOR 3 MAIL1 ;
  11974. Z0 = COOR 3 (MAIL2 POIN 1) ;
  11975. DMAX1 = (MINI (CHZ - Z0) 'ABS') * 0.9 ;
  11976. NBPAS1 = ENTIER ((DMAX1 + (PASB1/1000.))/PASB1) ;
  11977. *
  11978. *---- distance a parcourir avec test d'intersection
  11979. DMAX2 = (MAXI (CHZ - Z0) 'ABS') * 2. - DMAX1 ;
  11980. NBPAS2 = ENTIER ((DMAX2 + (PASB2/1000.))/PASB2) ;
  11981. *
  11982. *---- distance a parcourir
  11983. DMAX0 = (NBPAS1 * PASB1) + (NBPAS2 * PASB2) ;
  11984. *
  11985. *---- calcul exp(-delta/lambdaQ).ABS(b.n) aux points
  11986. *---- d'intersection avec une methode analytique
  11987. TAB1.<NOMBRE_PAS_SANS_TEST = NBPAS1 ;
  11988. TAB1.<NOMBRE_PAS_AVEC_TEST = NBPAS2 ;
  11989. TAB1.<DISTANCE_SANS_TEST = DMAX1;
  11990. TAB1.<DISTANCE_AVEC_TEST = DMAX2 ;
  11991. *
  11992. CHFNORM = @ANADES TAB1 ;
  11993. *
  11994. *---- Champ magnetique sur les points d'intersection
  11995. TAB1.<MAILLAGE_B = EXTR CHFNORM 'MAIL' ;
  11996. TITRE 'TEST : MAILLAGE INITIAL DEFORME ';
  11997. TRAC ((TAB1.<MAILLAGE_B) ET MAIL1 ET (TAB1.<GRILLE_B) ET (TAB1.<MAILLAGE_FN));
  11998. *
  11999. BR BZ BPHI = @MAGNB TAB1 ;
  12000. *
  12001. PHI = ATG (COOR 2 TAB1.<MAILLAGE_B) (COOR 1 TAB1.<MAILLAGE_B) ;
  12002. BX = BR * (COS PHI) - (BPHI * (SIN PHI));
  12003. BY = BR * (SIN PHI) + (BPHI * (COS PHI));
  12004. *AM*11/09/01*BX = BR * (COS PHI) + (BPHI * (SIN PHI));
  12005. *AM*11/09/01*BY = BR * (SIN PHI) - (BPHI * (COS PHI));
  12006. *
  12007. *---- Calcul de b.n sur le maillage "ombrant"
  12008. B_NORM = ((BX*BX) + (BY*BY) + (BZ*BZ))**0.5 ;
  12009. VBVN = (ABS BZ) / B_NORM ;
  12010. *
  12011. *---- calcul de exp (-delta/lambdaQ)
  12012. VAR1 = CHFNORM / VBVN ;
  12013. *
  12014. *---- on retrouve la forme initiale de TAB1.<S_OMBRE
  12015. FORM (TAB1.<DEPLACEMENT * (-1.)) ;
  12016. TITRE 'TEST : RETOUR FORME INITIALE' ;
  12017. TRAC ((TAB1.<MAILLAGE_B) ET MAIL1 ET (TAB1.<GRILLE_B) ET (TAB1.<MAILLAGE_FN));
  12018.  
  12019. MESS '>@FLNORM> distance covered :' TAB1.<LONGUEUR_PARCOURUE;
  12020.  
  12021. SI (EGA (TAB1.<LONGUEUR_CONNEXION_MAX) 0.) ;
  12022. MESS '>@FLNORM> no interception found';
  12023. SINON;
  12024. MESS '>@FLNORM> mini - maxi connection length' (mini TAB1.<CHAMP_DISTANCE) TAB1.<LONGUEUR_CONNEXION_MAX ;
  12025. FINSI;
  12026. *
  12027. MESS '---------------------------------> exiting @FLNORM';
  12028. FINPROC VAR1 ;
  12029.  
  12030. **** @FLUCRIT
  12031. DEBPROC @FLUCRIT TAB1*TABLE ;
  12032. *
  12033. * --- entrees
  12034. *
  12035. CHOIX = TAB1.'CHFCORRELATION';
  12036. NIVEAU = TAB1.'NIVEAU' ;
  12037. *
  12038. * --- racine
  12039. *
  12040. SI (NIVEAU >EG 4 ) ;
  12041. MESS '-----------------------------------> calling @FLUCRIT' ;
  12042. FINSI ;
  12043. * Calculs thermohydrauliques et bilans thermiques
  12044. * en attendant de les passer dans thersch1
  12045.  
  12046.  
  12047. *
  12048. * --- traitement
  12049. *
  12050. I1 = 1 ;
  12051. REPETER BOUC1 (DIME CHOIX) ;
  12052. ICHOIX = EXTR CHOIX I1 ;
  12053. LOGI1 = EGA ICHOIX 'BOWR' ;
  12054. LOGI2 = EGA ICHOIX 'TONG' ;
  12055. LOGI3 = EGA ICHOIX 'CELA' ;
  12056. LOGITOT1 = LOGI1 OU LOGI2 OU LOGI3 ;
  12057. SI (NON LOGITOT1) ;
  12058. ERRE '@FLUCRIT mot cle different de BOWR,TONG ou CELA' ;
  12059. FINSI ;
  12060. *
  12061. * --- Bowring72
  12062. *
  12063. SI (EGA ICHOIX 'BOWR') ;
  12064. TIN1 = TAB1.'T_IN' ;
  12065. PRESS1 = TAB1.'P_IN' ;
  12066. VITESS1 = TAB1.'V_IN' ;
  12067. EL = TAB1.'L_HEATED' ;
  12068. XL1 = TAB1.'WE_HEATED' ;
  12069. D1 = TAB1.'D_MAQUETTE' ;
  12070. YTWIST = TAB1.'TWIST_RATIO' ;
  12071. TTAPE = TAB1.'T_TAPE' ;
  12072. PI = 3.14159 ;
  12073. SI ( YTWIST EGA 0. ) ;
  12074. TAB1.DHC = D1 ;
  12075. S1 = PI * D1 * D1 / 4. ;
  12076. TAB1.DH = D1 ;
  12077. FACV = 1. ;
  12078. FACS = 1. ;
  12079. SINON ;
  12080. SI ( NON ( EXISTE TAB1 'N_CANAUX' )) ;
  12081. TAB1 . N_CANAUX = 2. ;
  12082. FINSI ;
  12083. SS2 = ( ( PI * D1 * D1 / 8.) - ( TTAPE * D1 / 2. ) ) ;
  12084. S1 = SS2 * TAB1 . N_CANAUX ;
  12085. QUAS = 4. * SS2 ;
  12086. PERI = ( ( PI * D1 / 2.) - TTAPE + D1 ) ;
  12087. TAB1.DH = QUAS / PERI ;
  12088. FINSI ;
  12089. TAB1.T_IN = TIN1;
  12090. TAB1.P_IN = PRESS1;
  12091. TAB1.V_IN = VITESS1;
  12092. @BOWRI72 TAB1 ;
  12093. QCHFW = TAB1.CHF ;
  12094. FINSI ;
  12095. *
  12096. * --- Tong75
  12097. *
  12098. SI (EGA ICHOIX 'TONG') ;
  12099. @TABEAU TAB1 ;
  12100. VIN = TAB1.V_IN ;
  12101. TIN = TAB1.T_IN ;
  12102. PRES1 = TAB1.P_LOCAL ;
  12103. D1 = TAB1.D_MAQUETTE ;
  12104. EL = TAB1.L_HEATED ;
  12105. XL1 = TAB1.WE_HEATED ;
  12106. TAB1.V_LOCAL = VIN ;
  12107. SI ( NON ( EXISTE TAB1 TWIST_RATIO ) ) ;
  12108. TAB1 . TWIST_RATIO = 0. ;
  12109. FINSI ;
  12110. YTWIST = TAB1 . TWIST_RATIO ;
  12111. SI ( NON ( EXISTE TAB1 T_TAPE ) ) ;
  12112. TAB1 . T_TAPE = 0. ;
  12113. FINSI ;
  12114. TTAPE = TAB1 . T_TAPE ;
  12115. QSURFE = TAB1.V_FLUMOY1 ;
  12116. TSAT = @IPOE PRES1 TAB1.EPTSAT ;
  12117. RHOIN = @IPOE TIN TAB1.ETRHOF ;
  12118. GIN = RHOIN * VIN ;
  12119. HIN = @IPOE TIN TAB1.ETHF ;
  12120. HSAT = @IPOE TSAT TAB1.ETHF ;
  12121. PI = 3.14159 ;
  12122. SI ( ( YTWIST EGA 0. ) ET ( EGA TAB1.HYPERVAP FAUX ) ) ;
  12123. TAB1.DHC = D1 ;
  12124. S1 = PI * D1 * D1 / 4. ;
  12125. TAB1.DH = D1 ;
  12126. FACV = 1. ;
  12127. FACS = 1. ;
  12128. TAB1.M_TONG = MOT 'TONG75' ;
  12129. * FACF = 1. ;
  12130. FINSI ;
  12131. SI ( NON ( EXISTE TAB1 HELI_WIRE ) ) ;
  12132. TAB1.HELI_WIRE = FAUX ;
  12133. FINSI ;
  12134. SI ( NON ( EXISTE TAB1 HYPERVAP ) ) ;
  12135. TAB1.HYPERVAP = FAUX ;
  12136. FINSI ;
  12137. SI ( ( YTWIST EGA 0. ) ET ( EGA TAB1.HELI_WIRE VRAI )) ;
  12138. S1 = PI * D1 * D1 / 4. ;
  12139. SM = PI * TAB1.WIRE_D * TAB1.WIRE_D / 4. ;
  12140. P1 = PI * D1 ;
  12141. PM = PI * TAB1.WIRE_D ;
  12142. TAB1.DH = 4. * ( S1 - SM ) / ( P1 + PM ) ;
  12143. PIS2Y = PI / ( 2 * TAB1.PITCH_WIRE ) ;
  12144. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  12145. * FACV = 1. ;
  12146. FACF = 1. ;
  12147. TAB1.M_TONG = MOT 'TONG75' ;
  12148. FINSI ;
  12149. *
  12150. SI ( NON ( EXISTE TAB1 HYPERVAP ) ) ;
  12151. TAB1.HYPERVAP = FAUX ;
  12152. FINSI ;
  12153. SI ( ( YTWIST EGA 0. ) ET ( EGA TAB1.HYPERVAP VRAI ) ) ;
  12154. SM = ( TAB1 . LARG_CANAL * TAB1 . HMIN_CANAL ) + ( 2. * ( TAB1 . LARG_ESP * TAB1 . HFIN ) ) ;
  12155. PM = TAB1 . LARG_CANAL + ( 2.* TAB1 . HMAX_CANAL ) + ( 2. * TAB1 . LARG_ESP ) + ( 2. * TAB1 . HFIN ) + TAB1 . LFIN ;
  12156. TAB1.DH = 4. * SM / PM ;
  12157. FACV = 1. ;
  12158. FACF = 1. ;
  12159. TAB1.HYP_SM = SM ;
  12160. FINSI ;
  12161. *
  12162. SI ( YTWIST > 0. ) ;
  12163. SI ( NON ( EXISTE TAB1 'N_CANAUX' )) ;
  12164. TAB1 . N_CANAUX = 2. ;
  12165. FINSI ;
  12166. SS2 = ( ( PI * D1 * D1 / 8.) - ( TTAPE * D1 / 2. ) ) ;
  12167. S1 = SS2 * TAB1 . N_CANAUX ;
  12168. QUAS = 4. * SS2 ;
  12169. PERI = ( ( PI * D1 / 2.) - TTAPE + D1 ) ;
  12170. TAB1.DH = QUAS / PERI ;
  12171. TAB1.DHC = 4. * ( ( PI * D1 * D1 / 4.) - ( TTAPE * D1 ) ) / ( ( PI * D1 ) - ( TTAPE * 2.) ) ;
  12172. PIS2Y = PI / ( 2. * YTWIST ) ;
  12173. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  12174. FACF = 1.15 ;
  12175. FACS = 1.67 ;
  12176. TAB1.M_TONG = MOT '1.67*TONG75' ;
  12177. FINSI ;
  12178. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  12179. HLOCAL = HIN + ( QSURFE * XL1 * EL / ( GIN * TAB1.HYP_SM ) ) ;
  12180. SINON ;
  12181. HLOCAL = HIN + ( QSURFE * XL1 * EL / ( GIN * S1 ) ) ;
  12182. FINSI ;
  12183. SI ( HLOCAL < HSAT ) ;
  12184. SI ( HLOCAL >EG HIN ) ;
  12185. TLOCAL = @IPOE HLOCAL TAB1.EHFT ;
  12186. SINON ;
  12187. MESS '>@FLUCRIT> HLOCAL < HIN ?????====== ' ;
  12188. ERREUR '>@FLUCRIT> HLOCAL < HIN' ;
  12189. FINSI ;
  12190. SINON ;
  12191. TLOCAL = TSAT ;
  12192. * HLOCAL = HSAT ;
  12193. FINSI ;
  12194. TAB1.'HLOCAL' = HLOCAL ;
  12195. @TONG75 TAB1 ;
  12196. QCHFW = TAB1.CHF ;
  12197. FINSI ;
  12198. *
  12199. * --- Celata94
  12200. *
  12201. SI (EGA ICHOIX 'CELA') ;
  12202. @CELAT94 TAB1 ;
  12203. QCHFW = TAB1.CHF ;
  12204. FINSI ;
  12205. *
  12206. * --- fin des appels
  12207. *
  12208. SI (EGA I1 1) ;
  12209. L_QCHFW = PROG QCHFW ;
  12210. SINON ;
  12211. L_QCHFW = L_QCHFW ET (PROG QCHFW) ;
  12212. FINSI ;
  12213. I1 = I1 + 1 ;
  12214. FIN BOUC1 ;
  12215.  
  12216. MESS '>@FLUCRIT> Critical Heat Flux output';
  12217. LIST L_QCHFW ;
  12218. *
  12219. * --- sorties
  12220. *
  12221. TAB1.'L_QCHFW' = L_QCHFW ;
  12222.  
  12223. SI (NIVEAU >EG 4 ) ;
  12224. MESS '-----------------------------------> exiting @FLUCRIT' ;
  12225. FINSI ;
  12226.  
  12227. FINPROC ;
  12228. **** @FLUXH
  12229. DEBPROC @FLUXH TAB1*TABLE ;
  12230. *---------------------------------------------------------------------
  12231. * Procedure @FLUXH
  12232. *---------------------------------------------------------------------
  12233. MESS '---------------------------------> calling @FLUXH';
  12234. V_DIM1 = VALEUR 'DIME' ;
  12235. S_TOT1 = TAB1.M_ILLAGE_TOT ;
  12236. COSDIR1 COSDIR2 COSDIR3 = @VNORM3D (EXTR TAB1.'MODELF' 'MAIL') (TAB1.LFLUX_EXTE) TAB1.'NIVEAU';
  12237. COTETF1 = COSDIR1 ;
  12238. SITETF1 = COSDIR2;
  12239. TETF1 = ATG SITETF1 ( COTETF1 + 1.E-12) ;
  12240.  
  12241. SI (EXISTE TAB1 'VAL_ANGLEI1');
  12242. MESS '>>>>@FLUXH Le flux d electrons est forcement selon OY ';
  12243. MESS '>>>>@FLUXH a l axe y, si autre angle tournez avec DEPL';
  12244. ERRE '>>>>@FLUXH TAB1 VAL_ANGLEI1 inoperant ici';
  12245. FINSI ;
  12246.  
  12247. *1 DDDDDDDDDD SI de niveau 1 : cas DIMENSION 2
  12248.  
  12249. SI ( V_DIM1 EGA 2) ;
  12250. MESS '>@FLUXH> 2D ';
  12251. VFON1 = TAB1.VPROFIL_W;
  12252. XFON1 = TAB1.XPROFIL_W;
  12253. LPAT1 = TAB1.LFLUX_EXTE;
  12254. LPAT1D = TAB1.LFLUX_EXTE_DESS ;
  12255. XLPAT1 = COOR 1 LPAT1;
  12256. XLPAT1D = COOR 1 LPAT1D;
  12257. XL_LPAT1 = ABS (( MAXI XLPAT1 ) - ( MINI XLPAT1 ));
  12258. VFON2 = ( IPOL XLPAT1 XFON1 VFON1 ) ;
  12259. EVV1 = EVOL CHPO XLPAT1 SCAL LPAT1D ;
  12260. *dess EVV1 ;
  12261. EVV2 = EVOL CHPO VFON2 SCAL LPAT1D ;
  12262. *dess EVV2 ;
  12263. VVFON2 = EXTR EVV2 ORDO 1 ;
  12264. XXPAT1 = EXTR EVV1 ORDO 1 ;
  12265. TITRE ' INCIDENT GUN FLUX PROFILE ' ;
  12266. dess ( EVOL MANU XXPAT1 VVFON2 ) ;
  12267. SOM1 = INTG ( EVOL MANU XXPAT1 VVFON2 ) ;
  12268. SOM1 = ABS ( MAXI SOM1 ) ;
  12269.  
  12270. * ajout RM le 27 10 95
  12271. SI (EGA (VALE MODE) 'AXIS') ;
  12272. MESS '>@FLUXH> mode axisymetrique' ;
  12273. SOM1 =(2. * 3.14159 * (INTG ( EVOL MANU XXPAT1 (VVFON2 * XXPAT1)))) ;
  12274. SOM1 = ABS ( MAXI SOM1 ) ;
  12275. FINSI ;
  12276. * fin locale de l ajout RM le 27 10 95
  12277.  
  12278. FACFM1 = SOM1 / XL_LPAT1 ;
  12279. MESS '>@FLUXH> VALEUR integrale DU PROFIL' SOM1;
  12280. MESS '>@FLUXH> LARGEUR MAQ. CHAUFFEE' (TAB1 . W_HEATED);
  12281. MESS '>@FLUXH> VALEUR moyenne DU PROFIL' FACFM1;
  12282. VPAT1 = VFON2 * SITETF1;
  12283. (MINI VPAT1) (MAXI VPAT1);
  12284. TAB1.'WE_HEATED_N'= XL_LPAT1 * (TAB1 . FSYM_X );
  12285. TAB1.'WE_HEATED'= XL_LPAT1 * (TAB1 . FSYM_X );
  12286. VPUI_1 = FACFM1 * XL_LPAT1;
  12287. TAB1.'V_FACFM1' = FACFM1;
  12288. MESS '>@FLUXH> direct integration' VPUI_1 ;
  12289.  
  12290. *
  12291. * --- test puissance incidente
  12292. *
  12293.  
  12294. * calcul apres utilisation de l operateur flux
  12295.  
  12296. FPAT1 = FLUX TAB1.'MODELF' VPAT1;
  12297. VPUI_2 = (MAXI (RESU FPAT1));
  12298. MESS '>@FLUXH> nodal intergration ' VPUI_2;
  12299.  
  12300. ERR_1 = VPUI_2 * 0.05;
  12301. SI( NON ( EGA VPUI_1 VPUI_2 ERR_1));
  12302. MESS '>@FLUXH> call the CONCEPTEUR ';
  12303. ERREUR 'POWER BALANCE';
  12304. SINON;
  12305. MESS '>@FLUXH> Ok Power Balance';
  12306. FINSI;
  12307.  
  12308. SOM1 = SOM1 * (EXTR TAB1.LIS_FLUX (DIME TAB1.LIS_FLUX));
  12309. SI (NON (EXISTE TAB1 'V_SOM1'));
  12310. TAB1.'V_SOM1' = SOM1;
  12311. SINON;
  12312. TAB1.'V_SOM1' = TAB1.'V_SOM1' + SOM1;
  12313. FINSI;
  12314. * 1 MMMMMMMM SINON de niveau 1 : cas DIMENSION 3
  12315. SINON ;
  12316.  
  12317. EXFLUX1 = TAB1.E_XPROFIL_W ;
  12318. EZFLUX1 = TAB1.E_ZPROFIL_W ;
  12319.  
  12320. SFLUX1 = TAB1.LFLUX_EXTE ;
  12321.  
  12322. XSFLUX1 = COOR 1 SFLUX1 ;
  12323. ZSFLUX1 = COOR 3 SFLUX1 ;
  12324.  
  12325. VXFLUX2 = ( @IPOE XSFLUX1 EXFLUX1 FIXE ) ;
  12326. VZFLUX2 = ( @IPOE ZSFLUX1 EZFLUX1 FIXE ) ;
  12327.  
  12328. VXZFLUX2 = VXFLUX2 * VZFLUX2 * COSDIR2 ;
  12329. PHFLUX1 = FLUX (TAB1.'MODELF') VXZFLUX2 ;
  12330. VMOY1 = MAXI ( ( RESU PHFLUX1) / ( MESU SFLUX1 ) ) ;
  12331. TAB1.'V_FACFM1'= VMOY1;
  12332. SOM1 = (MAXI (RESU PHFLUX1)) * (EXTR TAB1.LIS_FLUX (DIME TAB1.LIS_FLUX));
  12333. SI (NON (EXISTE TAB1 'V_SOM1'));
  12334. TAB1.'V_SOM1' = SOM1;
  12335. SINON;
  12336. TAB1.'V_SOM1' = TAB1.'V_SOM1' + SOM1;
  12337. FINSI;
  12338. VPAT1 = VXZFLUX2 / VMOY1 ;
  12339. *1 FFFFFFFFFF FINSI de niveau 1 : fin du test sur la dimension
  12340. FINSI ;
  12341. MESS '---------------------------------> exiting @FLUXH';
  12342. FINPROC VPAT1 ;
  12343.  
  12344. **** @FLUXQP
  12345. * Procedure @FLUXQP
  12346. *
  12347. *-----------------------------------------------------------------------
  12348. DEBPROC @FLUXQP TAB1*TABLE;
  12349. MESS '---------------------------------> calling @FLUXQP';
  12350. *
  12351. ****** ATTENTION --> Cette procedure ne tourne pour l'instant qu'en 2D
  12352.  
  12353. V_DIM1 = VALEUR 'DIME' ;
  12354. SI ( V_DIM1 EGA 3) ;
  12355. MESS '@FLUXQP ne tourne pas en 3D';
  12356. ERRE 'Dimension';
  12357. FINSI;
  12358.  
  12359. TAC1 = TABLE;
  12360. TAC1.1 = 'MARQ TRIA ';
  12361. TAC1.2 = 'MARQ TRIB ';
  12362. TAC1.3 = 'MARQ ETOI ';
  12363. TAC1.4 = 'MARQ LOSA ';
  12364. TAC1.5 = 'MARQ CROI ';
  12365. TAC1.6 = 'MARQ PLUS ';
  12366. S_TOT1 = TAB1.M_ILLAGE_TOT ;
  12367. LPAT1 = TAB1.LFLUX_EXTE ;
  12368. LPAT1D = TAB1.LFLUX_EXTE_DESS ;
  12369. COSDIR1 COSDIR2 COSDIR3 = @VNORM3D (EXTR TAB1.'MODELF' 'MAIL') LPAT1 TAB1.'NIVEAU';
  12370. COTETF1 = COSDIR1;
  12371. SITETF1 = COSDIR2;
  12372. TETF1 = ATG SITETF1 ( COTETF1 + 1.E-12) ;
  12373. SI (EXISTE TAB1 'VAL_ANGLEI1');
  12374. SI (EXISTE TAB1 'CENTRE_PLASMA');
  12375. ERREUR 'on ne peut avoir VAL_ANGLEI1 et CENTRE_PLASMA ' ;
  12376. SINON;
  12377. SINPA1 = COS ( (TETF1 * -1.) + (TAB1.'VAL_ANGLEI1'));
  12378. SIALPHA1 = ABS ( COS (TAB1.'VAL_ANGLEI1'));
  12379. COALPHA1 = ABS ( SIN (TAB1.'VAL_ANGLEI1'));
  12380. XXPAT1 = ABS ((COOR 1 LPAT1) - (COOR 1 TAB1.'PT_TGPLASMA'));
  12381. YYPAT1 = ABS ((COOR 2 LPAT1) - (COOR 2 TAB1.'PT_TGPLASMA'));
  12382. XLPAT1 = (XXPAT1*COALPHA1) + (YYPAT1*SIALPHA1);
  12383. XLPAT3 = XLPAT1;
  12384. FINSI;
  12385. SINON;
  12386. SI (NON (EXISTE TAB1 'CENTRE_PLASMA'));
  12387. ERREUR 'vous n avez pas donne TAB1.VAL_ANGLEI1';
  12388. SINON;
  12389. LOG1 = EGA (COOR 1 TAB1.'CENTRE_PLASMA') (COOR 1 TAB1.'PT_TGPLASMA') 1.E-6;
  12390. SI ( NON LOG1);
  12391. ERREUR ' COOR 1 CENTRE_PLASMA ET PT_TGPLASMA DIFFERENTS ' ;
  12392. FINSI;
  12393. R0 = (COOR 2 TAB1.'CENTRE_PLASMA') - (COOR 2 TAB1.'PT_TGPLASMA');
  12394. XXPAT1 = ((COOR 1 LPAT1) - (COOR 1 TAB1.'CENTRE_PLASMA')) ;
  12395. YYPAT1 = -1. * ((COOR 2 LPAT1) - (COOR 2 TAB1.'CENTRE_PLASMA')) ;
  12396. RXY = ((XXPAT1 * XXPAT1)+(YYPAT1 * YYPAT1))** 0.5 ;
  12397. ALPH1 = ATG XXPAT1 (YYPAT1 + 1.E-6) ;
  12398. XLPAT1 = RXY - R0 ;
  12399. SINPA1 = SIN ( ALPH1 + 90. - TETF1 ) ;
  12400. MASP1 = XXPAT1 MASQUE 'EGSUPE' 0. ;
  12401. MASM1 = XXPAT1 MASQUE 'INFERIEUR' 0. ;
  12402. XLPAT3 = (XLPAT1 * MASP1) - (XLPAT1 * MASM1) ;
  12403. FINSI;
  12404. FINSI;
  12405. MLAMB1 = ( TAB1 . 'LAMDAQ' ) * -1. ;
  12406. ELPAT1 = EXP ( XLPAT1 / MLAMB1 ) ; ;
  12407. VPAT1 = ELPAT1 * (ABS SINPA1) ;
  12408. *********** cas LAMBDAQ VPAT1 = exp*sinus
  12409. TAC1.TITRE = TABLE ;
  12410.  
  12411. *TITRE 'SIN(teta)' ;
  12412. EV1 = EVOL CHPO SINPA1 SCAL LPAT1D ;
  12413. *TITRE 'EXP(-DL/LAMB)' ;
  12414. EV2 = EVOL CHPO ELPAT1 SCAL LPAT1D ;
  12415. *TITRE 'SIN(teta)*EXP(-DL/LAMB)' ;
  12416. EV3 = EVOL CHPO VPAT1 SCAL LPAT1D ;
  12417. TAC1.1 = 'MARQ TRIA REGU ' ;
  12418. TAC1.TITRE.1 = 'SIN(teta)';
  12419. TAC1.2 = 'MARQ TRIB REGU TITR SIN(teta)' ;
  12420. TAC1.TITRE.2 = 'EXP(-DL/LAMB)';
  12421. TAC1.3 = 'MARQ ETOI REGU TITR EXP(-DL/LAMB)' ;
  12422. TAC1.TITRE.3 = 'SIN(teta)*EXP(-DL/LAMB)' ;
  12423. *TAC1.4 = 'MARQ LOSA REGU TITR EXP(-DL/LAMB)' ;
  12424. *TAC1.5 = 'MARQ CROI REGU TITR SIN(teta)*EXP(-DL/LAMB)' ;
  12425. *TAC1.6 = 'MARQ PLUS REGU TITR SIN(teta)*EXP(-DL/LAMB)' ;
  12426. TITRE 'SIN,EXP,SIN*EXP' ;
  12427. DESS ( EV1 ET EV2 ET EV3 ) LEGE TAC1;
  12428. MESS ' MIN MAX DE EXP*SINa ' (MINI VPAT1) (MAXI VPAT1);
  12429. TITRE 'EXP(-DL/LAMB) fonction de DL ' ;
  12430. EV4 = EVOL CHPO XLPAT3 SCAL LPAT1D ;
  12431. EV5 = ( EVOL MANU (EXTR EV4 ORDO 1) (EXTR EV2 ORDO 1));
  12432. TITRE 'EXP(-DL/LAMB) fonction de DL ';
  12433. DESS EV5 LEGE;
  12434. SOM1 = INTG EV5 ;
  12435. *********** cas LAMBDAQ VPAT1 = exp*sinus
  12436. *********** cas LAMBDAQ SOM1 = somme ( exp*sinus)
  12437. *********** cas LAMBDAQ FACFM1 = SOM1 / largeur
  12438. SOM1 = ABS (MAXI SOM1);
  12439. MESS '>@FLUXQP> VALEUR integrale DU PROFIL' SOM1;
  12440. MESS '>@FLUXQP> LARGEUR MAQ. CHAUFFEE' (TAB1 . W_HEATED );
  12441. XL_LPAT1 = ( ABS (( MAXI XLPAT1 ) - ( MINI XLPAT1 )));
  12442. FACFM1 = SOM1 / XL_LPAT1;
  12443. MESS '>@FLUXQP> LARGEUR vue du plasma' XL_LPAT1;
  12444. MESS '>@FLUXQP> VALEUR moyenne DU PROFIL' FACFM1;
  12445.  
  12446. SI (EXISTE TAB1 'LAMDAQ2');
  12447. LPAT2 = TAB1.LFLUX_EXT2 ;
  12448. LPAT2D = TAB1.LFLUX_EXT2 ;
  12449. COSDIR1 COSDIR2 COSDIR3 = @VNORM3D S_TOT1 LPAT2 TAB1.'NIVEAU';
  12450. COTETF2 = COSDIR1 * 1. ;
  12451. SITETF2 = COSDIR2 * 1. ;
  12452. COTETF1 = @ET COTETF1 COTETF2 ;
  12453. SITETF1 = @ET SITETF1 SITETF2 ;
  12454. TETF2 = ATG SITETF2 ( COTETF2 + 1.E-12) ;
  12455. MESS '>>>>> 3B>>>>>>' ;
  12456. SINPA2 = COS ( (TETF2 * -1.) + (TAB1.'VAL_ANGLEI2'));
  12457. SIALPHA2 = ABS ( COS (TAB1.'VAL_ANGLEI2')) ;
  12458. COALPHA2 = ABS ( SIN (TAB1.'VAL_ANGLEI2'));
  12459. XXPAT2 = ABS ((COOR 1 LPAT2) - (COOR 1 TAB1.'PT_TGPLASMA'));
  12460. YYPAT2 = ABS ((COOR 2 LPAT2) - (COOR 2 TAB1.'PT_TGPLASMA'));
  12461. XLPAT2 = (XXPAT2*COALPHA2) + (YYPAT2*SIALPHA2);
  12462. MLAMB2 = ( TAB1 . 'LAMDAQ2' ) * -1.;
  12463. ELPAT2 = EXP ( XLPAT2 / MLAMB2 );
  12464. VPAT2 = ELPAT2 * SINPA2;
  12465. VPAT2 = VPAT2 + (( REDU VPAT2 TAB1.'PT_TGPLASMA') * -1.);
  12466. VPAT1 = VPAT2 + VPAT1;
  12467. * VPAT1 = VPAT2;
  12468. TITRE 'SIN(teta)*EXP(-DL/LAMB)';
  12469. TAC1 = TABLE ;
  12470. TAC1.1 = 'MARQ TRIA ' ;
  12471. TAC1.2 = 'MARQ TRIB ' ;
  12472. TAC1.3 = 'MARQ ETOI ' ;
  12473. TAC1.4 = 'MARQ LOSA ' ;
  12474. TITRE 'SIN(teta)';
  12475. EV1 = EVOL CHPO SINPA2 SCAL LPAT2D;
  12476. TITRE 'EXP(-DL/LAMB)' ;
  12477. EV2 = EVOL CHPO ELPAT2 SCAL LPAT2D ;
  12478. TITRE 'SIN(teta)*EXP(-DL/LAMB)';
  12479. EV3 = EVOL CHPO VPAT2 SCAL LPAT2D ;
  12480. EV4 = EVOL CHPO XLPAT2 SCAL LPAT2D ;
  12481. DESS ( EV1 ET EV2 ET EV3 ) ;
  12482. MESS ' MIN MAX DE EXP*SIN22 ' (MINI VPAT2) (MAXI VPAT2);
  12483. TITRE 'EXP(-DL/LAMB) fonction de DL, ligne 2 ';
  12484. EV5 = (EVOL MANU (EXTR EV4 ORDO 1) (EXTR EV2 ORDO 1));
  12485. TAC1.1 = 'MARQ TRIA TITRE EXP(-DL/LAMB)' ;
  12486. TAC1.2 = 'MARQ TRIB TITRE EXP(-DL/LAMB)' ;
  12487. DESS EV5 LEGE TAC1;
  12488. SOM1 = SOM1 + (ABS ( MAXI (INTG EV5) )) ;
  12489. MESS '>CFLUX_TO> VALEUR integrale DU PROFIL' SOM1;
  12490. MESS '>CFLUX_TO> LARGEUR MAQ. CHAUFFEE' (TAB1 . W_HEATED);
  12491. XL_LPAT2 = ( ABS (( MAXI XLPAT2 ) - ( MINI XLPAT2 )));
  12492. XL_LPAT1 = XL_LPAT1 + XL_LPAT2;
  12493. FACFM1 = SOM1 / XL_LPAT1;
  12494. MESS '>CFLUX_TO> VALEUR moyenne DU PROFIL' FACFM1;
  12495. FINSI;
  12496.  
  12497. TAB1.'WE_HEATED_R'= XL_LPAT1 * (TAB1.FSYM_X);
  12498. TAB1.'WE_HEATED'= XL_LPAT1 * (TAB1.FSYM_X);
  12499. VPUI_1 = FACFM1 * XL_LPAT1;
  12500. MESS ' PUIS. LINEIQUE PARTIE MAILLEE ON DOIT TROUVER ' VPUI_1 ;
  12501. FPAT1 = FLUX (TAB1.'MODELF') VPAT1 ;
  12502. VPUI_2 = ( MAXI ( RESU FPAT1 ));
  12503. ERR_1 = VPUI_2 * 0.05;
  12504. MESS ' >>>>> RESULTANTE FLUX INCIDENT >>>>' VPUI_2;
  12505. SI( NON ( EGA VPUI_1 VPUI_2 ERR_1));
  12506. MESS '>> @FLUXQP: voir le CONCEPTEUR ';
  12507. * ERREUR 'BILAN DES PUISSANCES';
  12508. FINSI;
  12509.  
  12510. SOM1 = SOM1 * (EXTR TAB1.LIS_FLUX (DIME TAB1.LIS_FLUX));
  12511. SI (NON (EXISTE TAB1 'V_SOM1'));
  12512. TAB1.'V_SOM1' = SOM1;
  12513. SINON;
  12514. TAB1.'V_SOM1' = TAB1.'V_SOM1' + SOM1;
  12515. FINSI;
  12516. TAB1.'V_FACFM2'= FACFM1;
  12517. MESS '---------------------------------> Sortie de @FLUXQP';
  12518.  
  12519. FINPROC VPAT1;
  12520.  
  12521. **** @FLUXTOT
  12522. *-----------------------------------------------------------------------
  12523. * Procedure @FLUXTOT
  12524. *-----------------------------------------------------------------------
  12525. DEBPROC @FLUXTOT TAB1*TABLE;
  12526. *
  12527. ***********************************************************************
  12528. * @FLUXTOT developpee par Nicolas URAGO (avr-sept 1994) *
  12529. * largement revisitee par Jacques SCHLOSSER et Alain MOAL (aout 1995) *
  12530. ***********************************************************************
  12531. ******* ATTENTION --> Cette procedure ne tourne qu'en 3D et ne peut
  12532. * traiter que des cas de limiteurs plancher car
  12533. * Z (point tangent) = Z (centre du plasma)
  12534. *
  12535. MESS '---------------------------------> calling @FLUXTOT';
  12536. *
  12537. *-------------------- VARIABLES D'ENTREE
  12538. LPAT1 = TAB1.LFLUX_EXTE ;
  12539. GRP1 = TAB1.GRAND_RAYON ;
  12540. IMESS = TAB1.'NIVEAU' ;
  12541. PTG = TAB1.'PT_TGPLASMA';
  12542. MODEL0 = TAB1.'MODELF' ;
  12543. LAMBQ = TAB1.LAMDAQ ;
  12544. LISFLU = TAB1.LIS_FLUX ;
  12545. OEIL0 = TAB1.VIEW_P ;
  12546. *
  12547. SI (EXISTE TAB1 ANGLE_DEC) ;
  12548. PSI = TAB1.ANGLE_DEC ;
  12549. SINON;
  12550. PSI = 0.0 ;
  12551. FINSI;
  12552. *---------------------------------------
  12553. *
  12554. *---- On calcule pour chaque point de LPAT1, les coordonnees
  12555. *---- de son'centre plasma'.
  12556. XP1 = COOR 1 LPAT1 ;
  12557. YP1 = COOR 2 LPAT1 ;
  12558. ZP1 = COOR 3 LPAT1 ;
  12559. GRAYP1 = (XP1**2 + (YP1**2))**0.5 ;
  12560. XCP1 = XP1 * GRP1 / GRAYP1 ;
  12561. YCP1 = YP1 * GRP1 / GRAYP1 ;
  12562. *
  12563. AUX1 = ((XCP1 - XP1)**2 + ((YCP1 - YP1)**2))**0.5;
  12564. BETA1 = ATG (AUX1/ZP1) ;
  12565. ALPHA2 = ATG YCP1 XCP1 ;
  12566. *
  12567. *---- le vecteur tangent aux lignes de champ B est orthogonal
  12568. *---- a V = P1CP1
  12569. VX1 = XCP1 - XP1 ;
  12570. VY1 = YCP1 - YP1 ;
  12571. VZ1 = ZP1 * -1. ;
  12572. *
  12573. *---- B appartient au plan defini par les vecteurs K (0, 0, 1) et U
  12574. *UX1 = SIN (PSI + ALPHA2) ;
  12575. *UY1 = (COS (PSI + ALPHA2)) * -1. ;
  12576. *UZ1 = UX1 * 0. ;
  12577. *
  12578. UX1 = SIN (PSI - ALPHA2) ;
  12579. UY1 = COS (PSI - ALPHA2) ;
  12580. UZ1 = UX1 * 0. ;
  12581. *
  12582. *---- calcul de B
  12583. BZ = ((VZ1*UX1)**2 + ((VZ1*UY1)**2)) / ((VX1*UX1 + (VY1*UY1))**2) + 1. ;
  12584. BZ = BZ**(-0.5) * -1.;
  12585. BY = BZ * (VZ1*UY1) /(VX1*UX1 + (VY1*UY1)) * -1. ;
  12586. BX = BY * UX1 / UY1 ;
  12587. *
  12588. *---- Calcul du produit scalaire : VECTEUR TANGENT . NORMALE
  12589. NX NY NZ = @VNORM3D (EXTR MODEL0 'MAIL') LPAT1 IMESS ;
  12590. COS_BN = ABS ((BX*NX) + (BY*NY) + (BZ*NZ)) ;
  12591. *
  12592. *---- Coordonnees du point de tangence
  12593. XREF1 = COOR 1 PTG ;
  12594. YREF1 = COOR 2 PTG ;
  12595. ZREF1 = COOR 3 PTG ;
  12596. *
  12597. *---- Centre du plasma au dessus du point de tangence
  12598. XCREF1 = XREF1 * GRP1 / ((XREF1**2 + (YREF1**2))**0.5);
  12599. YCREF1 = YREF1 * GRP1 / ((XREF1**2 + (YREF1**2))**0.5);
  12600. *
  12601. *---- DREF1 est le petit rayon du plasma
  12602. DREF1 = (((XREF1-XCREF1)**2) + ((YREF1-YCREF1)**2) + (ZREF1**2))**.5;
  12603. DIST1 = (((XP1 - XCP1)**2) + ((YP1 - YCP1)**2) + (ZP1**2))**.5;
  12604. *
  12605. *---- Distance a la DSMF
  12606. LDEC1 = DIST1 - DREF1 ;
  12607. *
  12608. *---- Calcul du profil de flux
  12609. VPAT1 = COS_BN * (EXP (LDEC1/(-1.*LAMBQ))) ;
  12610. VFP1 = FLUX MODEL0 VPAT1 ;
  12611. *
  12612. *---- Visualisations
  12613. ARET0 = ARETE LPAT1 ;
  12614. TITRE '@FLUXTOT : B.N = COSINUS OF THE INCIDENCE ANGLE';
  12615. TRAC OEIL0 COS_BN LPAT1 ARET0;
  12616. TITRE '@FLUXTOT : TANGENT VECTOR TO THE MAGNETIC LINE';
  12617. VB = @CVECT BX BY BZ LPAT1 VERT;
  12618. TRAC OEIL0 VB LPAT1 ;
  12619. TITRE '@FLUXTOT : DISTANCE TO THE LCFS' ;
  12620. TRAC OEIL0 LDEC1 LPAT1 ARET0;
  12621. TITRE '@FLUXTOT : PROFILE OF THE INCIDENT FLUX' ;
  12622. TRAC OEIL0 VPAT1 LPAT1 ARET0;
  12623. *
  12624. *-------------------- VARIABLES EN SORTIE
  12625. *---- flux moyen et puissance
  12626. TAB1.V_SOM1 = (EXTR LISFLU (DIME LISFLU)) * (MAXI (RESU VFP1));
  12627. TAB1.V_FACFM2 = (MAXI (RESU VFP1)) / (MESU LPAT1) ;
  12628. *-----------------------------------------
  12629. *
  12630. MESS '---------------------------------> exiting @FLUXTOT';
  12631. FINPROC VPAT1 ;
  12632.  
  12633. **** @FLUXX
  12634. DEBPROC @FLUXX TAB1*TABLE;
  12635. *----------------------------------------------------------------------
  12636. * Procedure de calcul de flux incident dans differents cas de geometrie
  12637. *
  12638. * TAB1.DEPOT_FLUX = MOT 'CANON' : CANON A ELECTRON @FLUXH
  12639. * MOT 'PLASMAFLUX_2D' : PLASMA ou flux 2D @FLUXQP
  12640. * MOT 'PLASMA_3D' : PLASMA, 3D @FLUXTOT
  12641. * MOT 'FLUX_3D' : FLUX 3D directions // @FLUX_3D
  12642. * MOT 'RIPPLE_SHIFT' : 2D ou 3D avec @TOKAFLU
  12643. * RIPPLE et SHIFT
  12644. * de SHAFRANOV
  12645. *
  12646. *'PLASMAFLUX_2D' regroupe en fait 3 cas :
  12647. * plasma en coupe poloidale (petit cercle)
  12648. * plasma en coupe toroidale (bande)
  12649. * plasma modelise par des lignes //
  12650. *js 26/3/96
  12651. *js TAB1.LIS_FLUX est une des entrees il faudrait pour plus de clarte
  12652. *js TAB1.LIS_FLUXM cas du canon a electron
  12653. *js TAB1.LIS_FLUX = TAB1.LIS_PHI0 cas des PLASMAS
  12654. *js
  12655. *js
  12656. *js il sort de la procedure
  12657. *js
  12658. *js TAB1.'VFPAT1'.INT1 chpoint du chargement total
  12659. *js
  12660. *js TAB1.'LIS_FLUMOYEN' liste des flux moyens en principe au sens de
  12661. *js la MESU TAB1.LFLUX_EXTE (mais ce qui n'est pas bon c'est que parfois
  12662. *js c'est pris sur la largeur de srape off layer intercepte
  12663. *js
  12664. *js
  12665. *js TAB1.'LIS_PUI1' c'est en principe TAB1.'LIS_FLUMOYEN'
  12666. *(MESUTAB1.LFLUX_EXTE)
  12667. *js
  12668. *js il faudrait tjs faire dans cette procedure
  12669. *js
  12670. *js FPAT1 = FLUX (TAB1 . 'MODELF') TAB1.'VFPAT1'.INT1 ;
  12671. *js TAB1.'LIS_PUI1' = TAB1.'LIS_PUI1' ET PROG ((RESU FPAT1)) ;
  12672. *js TAB1.'LIS_FLUMOYEN' = TAB1.'LIS_PUI1' /(MESU TAB1.LFLUX_EXTE);
  12673. *js
  12674. *js une fois ces changements faits proprement
  12675. *js
  12676. *js attention aux modif dans TPERM (facile) PPERM
  12677. *js (complexe mais ca devrait eclaicir)
  12678. *js et TTRANS PTRANS
  12679. *js et dans les procedures appelees par FLUXX
  12680. *js une fois ces modifs faites il est facile de rajouter un flux additionnel
  12681. *js TAB1.'VFPAT1'.INT1 = TAB1.'VFPAT1'.INT1 + TAB1.FLUX_ADDITIONNEL
  12682. *js
  12683. *js
  12684. *js
  12685. *MESS 'JS 220296 Attention il faut maintenant concatener';
  12686. *MESS 'cat fluxx.procedur fluxh.procedur fluxqp.procedur' ;
  12687. *MESS ' fluxtot.procedur flux_3d.procedur > fluxx.bidon' ;
  12688. *MESS 'et utiliser fluxx.bidon a la place de fluxx.procedur';
  12689. *MESS 'en cas de pb l ancienne procedure est disponible dans';
  12690. *MESS ' ~schlos/fluxx.procedur.220296.old';
  12691. *
  12692. MESS ' ';
  12693. *
  12694. * --- entrees
  12695. *
  12696. NIVEAU = TAB1.'NIVEAU';
  12697. SI (NIVEAU >EG 4) ;
  12698. MESS '---------------------------------> calling @FLUXX';
  12699. FINSI ;
  12700.  
  12701. ***************
  12702. * ON TESTE SI IL Y A UN FLUX OU DEUX FLUX A SUPERPOSER.
  12703. SI (EXISTE TAB1 LIS_FLUXP);
  12704. SI (EGA (DIME TAB1.LIS_FLUX) (DIME TAB1.LIS_FLUXP));
  12705. BOOL1 = VRAI;
  12706. TMP = TABLE;
  12707. SINON;
  12708. ERRE 'TAB1.LIS_FLUX et TAB1.LIS_FLUXP ne sont pas de meme longueur';
  12709. FINSI;
  12710. SINON;
  12711. BOOL1 = FAUX;
  12712. FINSI;
  12713.  
  12714. ************
  12715. * CONSTRUCTION DE VPAT1 : PROFIL DU FLUX INCIDENT
  12716. *
  12717. SI (EXISTE TAB1 DEPOT_FLUX);
  12718. IVERIF = 0 ;
  12719. SI (EGA TAB1.DEPOT_FLUX 'CANON');
  12720. VPAT1 = @FLUXH TAB1;
  12721. IVERIF = 1 ;
  12722. FINSI ;
  12723. SI (EGA TAB1.DEPOT_FLUX 'PLASMAFLUX_2D');
  12724. VPAT1 = @FLUXQP TAB1;
  12725. IVERIF = 1 ;
  12726. SI BOOL1;
  12727. TMP = TAB1.LIS_FLUX;
  12728. TAB1.LIS_FLUX = TAB1.LIS_FLUXP;
  12729. VPAT2 = @FLUXH TAB1;
  12730. TAB1.LIS_FLUX = TMP;
  12731. FINSI;
  12732. FINSI ;
  12733. SI (EGA TAB1.DEPOT_FLUX 'FLUX_3D');
  12734. VPAT1 = @FLUX_3D TAB1;
  12735. IVERIF = 1 ;
  12736. FINSI ;
  12737. SI (EGA TAB1.DEPOT_FLUX 'PLASMA_3D');
  12738. VPAT1 = @FLUXTOT TAB1;
  12739. VFP1 = FLUX TAB1.'MODELF' VPAT1 ;
  12740. IVERIF = 1 ;
  12741. FINSI ;
  12742. SI (EGA TAB1.DEPOT_FLUX 'RIPPLE_SHIFT');
  12743. VPAT1 = @TOKAFLU TAB1;
  12744. SI (EXISTE TAB1 <PENETRATION) ;
  12745.  
  12746. SI (TAB1.<PENETRATION) ;
  12747. * ---- Prise en compte de la penetration
  12748. PROFPEN0 = @TOKAPEN TAB1;
  12749. VPAT1 = VPAT1 + PROFPEN0 ;
  12750. FINSI;
  12751. FINSI;
  12752. VFP1 = FLUX TAB1.'MODELF' VPAT1 ;
  12753. SI (EXISTE TAB1 <PUISSANCE_EXTRAITE) ;
  12754. TAB1.LIS_FLUX = TAB1.<PUISSANCE_EXTRAITE/(MAXI(RESU VFP1));
  12755. FINSI ;
  12756. VFP1 = FLUX TAB1.'MODELF' VPAT1 ;
  12757. * ---- pourquoi ne prendre que la derniere valeur de TAB1.LIS_FLUX
  12758. TAB1.V_SOM1 = (EXTR TAB1.LIS_FLUX (DIME TAB1.LIS_FLUX)) * (MAXI (RESU VFP1));
  12759. IVERIF = 1 ;
  12760. FINSI ;
  12761. SI (IVERIF EGA 0) ;
  12762. ERRE ' FLUXX : VERIFIER LA VALEUR DE TAB1.DEPOT_FLUX';
  12763. FINSI ;
  12764. SINON ;
  12765. ERRE ' FLUXX : PRECISEZ LA VALEUR TAB1.DEPOT_FLUX';
  12766. FINSI ;
  12767. TAB1.V_VPAT1 = VPAT1;
  12768.  
  12769. ***********
  12770. * CONSTRUCTION DE VFPAT1 : FLUX INCIDENT
  12771. *
  12772. TAB1.'VFPAT1' = TABLE;
  12773. DIME1 = DIME TAB1.LIS_FLUX;
  12774. INT1 = 0;
  12775. REPETER BOUC1 DIME1;
  12776. INT1 = INT1 + 1;
  12777. TAB1.'VFPAT1'.INT1 = (VPAT1 * (EXTR TAB1.LIS_FLUX INT1));
  12778. FIN BOUC1;
  12779. * AJOUT DU SECOND FLUX SI BESOIN
  12780. SI BOOL1;
  12781. INT1 = 0;
  12782. REPETER BOUC2 DIME1;
  12783. INT1 = INT1 + 1;
  12784. TAB1.'VFPAT1'.INT1 = TAB1.'VFPAT1'.INT1 + (VPAT2 * (EXTR TAB1.LIS_FLUXP INT1));
  12785. FIN BOUC2;
  12786. FINSI;
  12787.  
  12788. ***********************************
  12789. * PRISE EN COMPTE DE LA PENETRATION
  12790. SI ((NEG TAB1.DEPOT_FLUX 'CANON') ET (EXISTE TAB1 PENETRATION));
  12791. @CALPENE TAB1;
  12792. FINSI;
  12793.  
  12794.  
  12795. *****************************************
  12796. * CALCUL DE LA PUISSANCE ET DU FLUX MOYEN
  12797.  
  12798. SI (TAB1.PERMANENT);
  12799. INT2 = 0;
  12800. SINON;
  12801. SI (TAB1.TRANSITOIRE);
  12802. INT2 = (DIME TAB1.LIS_FLUX) - 1;
  12803. SINON;
  12804. ERRE 'IL FAUT CHOISIR PERMANENT OU TRANSITOIRE';
  12805. FINSI;
  12806. FINSI;
  12807. SI ((EGA TAB1.DEPOT_FLUX 'CANON') OU BOOL1);
  12808. SI BOOL1;
  12809. TAB1.'LIS_FLUMOYEN' = TAB1.LIS_FLUXP * TAB1.V_FACFM1;
  12810. SINON;
  12811. TAB1.'LIS_FLUMOYEN' = TAB1.LIS_FLUX * TAB1.V_FACFM1;
  12812. FINSI;
  12813. TAB1.'LIS_PUI1' = TAB1.'LIS_FLUMOYEN' * TAB1.L_HEATED * TAB1.WE_HEATED_N;
  12814. FINSI;
  12815. SI (NON (EGA TAB1.DEPOT_FLUX 'CANON'));
  12816. TAB1.'LIS_FLUMOYEN' = TAB1.LIS_FLUX * TAB1.V_FACFM2;
  12817. SI (EGA TAB1.DEPOT_FLUX 'PLASMAFLUX_2D');
  12818. SI (EXISTE TAB1 CENTRE_PLASMA);
  12819. TAB1.'LIS_PUI1' = TAB1.'LIS_FLUMOYEN' * TAB1.B_HEATED * TAB1.WE_HEATED_R;
  12820. SINON;
  12821. TAB1.'LIS_PUI1' = TAB1.'LIS_FLUMOYEN' * TAB1.L_HEATED * TAB1.WE_HEATED_R;
  12822. FINSI;
  12823. SI (EXISTE TAB1 PENETRATION);
  12824. TAB1.'LIS_PUI1' = TAB1.LIS_PUIPENE * TAB1.L_HEATED;
  12825. FINSI;
  12826. SINON;
  12827. SI ((VALE DIME) EGA 3);
  12828. TAB1.'LIS_PUI1'= TAB1.'LIS_FLUMOYEN' * (MESU TAB1.LFLUX_EXTE);
  12829. SINON ;
  12830. SI ( EXISTE TAB1 B_HEATED) ;
  12831. TAB1.'LIS_PUI1'= TAB1.'LIS_FLUMOYEN' * (MESU TAB1.LFLUX_EXTE)* (TAB1.B_HEATED);
  12832. SINON ;
  12833. TAB1.'LIS_PUI1'= TAB1.'LIS_FLUMOYEN' * (MESU TAB1.LFLUX_EXTE)* (TAB1.L_HEATED);
  12834. FINSI ;
  12835. FINSI ;
  12836. FINSI;
  12837. FINSI;
  12838.  
  12839. *jsTAB1.'FLU1' = TABLE;
  12840. *jsTAB1.'PUI1' = TABLE;
  12841. *jsNB1 = (DIME TAB1.LIS_FLUX) - INT2;
  12842. *jsREPETER BOUC3 NB1;
  12843. *js INT2 = INT2 + 1;
  12844. *js TAB1.'PUI1'.INT2 = 0.;
  12845. *js SI ((EGA TAB1.DEPOT_FLUX 'CANON') OU BOOL1);
  12846. *js SI BOOL1;
  12847. *js FLU1 = (EXTR TAB1.LIS_FLUXP INT2) * TAB1.V_FACFM1;
  12848. *js SINON;
  12849. *js FLU1 = (EXTR TAB1.LIS_FLUX INT2) * TAB1.V_FACFM1;
  12850. *js FINSI;
  12851. *js TAB1.'FLU1'.INT2 = FLU1;
  12852. *js TAB1.'PUI1'.INT2 = FLU1 * TAB1.L_HEATED * TAB1.WE_HEATED_N;
  12853. *js FINSI;
  12854. *js SI (NON (EGA TAB1.DEPOT_FLUX 'CANON'));
  12855. *js FLU1 = (EXTR TAB1.LIS_FLUX INT2) * TAB1.V_FACFM2;
  12856. *js TAB1.'FLU1'.INT2 = FLU1;
  12857. *js SI (EGA TAB1.DEPOT_FLUX 'PLASMAFLUX_2D');
  12858. *js SI (EXISTE TAB1 CENTRE_PLASMA);
  12859. *js TAB1.'PUI1'.INT2 = TAB1.'PUI1'.INT2
  12860. *js + (FLU1 * TAB1.B_HEATED * TAB1.WE_HEATED_R);
  12861. *js SINON;
  12862. *js TAB1.'PUI1'.INT2 = TAB1.'PUI1'.INT2
  12863. *js + (FLU1 * TAB1.L_HEATED * TAB1.WE_HEATED_R);
  12864. *js FINSI;
  12865. *js SI (EXISTE TAB1 PENETRATION);
  12866. *js TAB1.'PUI1'.INT2 = TAB1.'PUI1'.INT2
  12867. *js + (TAB1.PUIPENE.INT2 * TAB1.L_HEATED);
  12868. *js FINSI;
  12869. *js SINON;
  12870. *js TAB1.'PUI1'.INT2 = FLU1 * (MESU TAB1.LFLUX_EXTE);
  12871. *js FINSI;
  12872. *js FINSI;
  12873. *jsFIN BOUC3;
  12874. SI (NIVEAU >EG 4) ;
  12875. MESS '--------------------------> exiting @FLUXX';
  12876. FINSI ;
  12877. MESS '>>>FLUXX>> FLU_MOYEN ET PUI1';
  12878. list TAB1.'LIS_FLUMOYEN';
  12879. list TAB1.'LIS_PUI1';
  12880. FINPROC;
  12881.  
  12882.  
  12883. **** @FLUX_3D
  12884. *--------------------------------------------------------------------
  12885. * Procedure @FLUX_3D
  12886. *--------------------------------------------------------------------
  12887. DEBPROC @FLUX_3D TAB1*TABLE;
  12888. MESS '---------------------------------> calling @FLUX_3D';
  12889. *
  12890. ****** ATTENTION --> Cette procedure ne tourne qu'en 3D
  12891.  
  12892. S_TOT1 = TAB1.M_ILLAGE_TOT ;
  12893. LPAT1 = TAB1.LFLUX_EXTE ;
  12894. COSDIR1 COSDIR2 COSDIR3 = @VNORM3D (EXTR TAB1.'MODELF' 'MAIL') LPAT1 TAB1.'NIVEAU';
  12895.  
  12896. SI ((EXISTE TAB1 VAL_ANGLEI1) ET (EXISTE TAB1 VAL_ANGLEI2));
  12897. SI (EXISTE TAB1 CENTRE_PLASMA);
  12898. ERREUR 'ON NE PEUT PAS AVOIR ANGLEI1 ET LE CENTRE DU PLASMA';
  12899. FINSI;
  12900. SINON;
  12901. ERR 'CAS NON PREVU POUR L INSTANT';
  12902. FINSI;
  12903.  
  12904. *
  12905. * CALCUL DES DISTANCES AU POINT DE TANGENCE
  12906. *******************************************
  12907. COSP1 = (COS TAB1.VAL_ANGLEI1) * (COS TAB1.VAL_ANGLEI2);
  12908. COSP2 = (COS TAB1.VAL_ANGLEI1) * (SIN TAB1.VAL_ANGLEI2);
  12909. COSP3 = SIN TAB1.VAL_ANGLEI1;
  12910. XPTG = COOR 1 TAB1.PT_TGPLASMA;
  12911. YPTG = COOR 2 TAB1.PT_TGPLASMA;
  12912. ZPTG = COOR 3 TAB1.PT_TGPLASMA;
  12913. XP1 = COOR 1 LPAT1;
  12914. YP1 = COOR 2 LPAT1;
  12915. ZP1 = COOR 3 LPAT1;
  12916. A1 = (COSP1*(XPTG - XP1)) + (COSP2*(YPTG - YP1)) + (COSP3*(ZPTG - ZP1));
  12917. B1 = (COSP1**2) + (COSP2**2) + (COSP3**2);
  12918. T1 = A1/B1;
  12919. XM1 = XPTG - (T1 * COSP1);
  12920. YM1 = YPTG - (T1 * COSP2);
  12921. ZM1 = ZPTG - (T1 * COSP3);
  12922.  
  12923. L1 = (((XM1 - XP1)**2) + ((YM1 - YP1)**2) + ((ZM1 - ZP1)**2))**.5;
  12924.  
  12925. *
  12926. * CALCUL DU PRODUIT SCALAIRE FLUX.NORMALE
  12927. *****************************************
  12928. VN1 = ( EXCO 'SCAL' COSDIR1 'UX' ) + ( EXCO 'SCAL' COSDIR2 'UY' ) + ( EXCO 'SCAL' COSDIR3 'UZ' ) ;
  12929. DFL1 = MANU CHPO LPAT1 3 'FX' COSP1 'FY' COSP2 'FZ' COSP3;
  12930. SIN1 = ABS (PSCA VN1 DFL1 (MOTS 'UX' 'UY' 'UZ') (MOTS 'FX' 'FY' 'FZ'));
  12931.  
  12932.  
  12933. VPAT1 = EXP (-1.*L1/TAB1.LAMDAQ) * SIN1;
  12934.  
  12935. TRAC QUAL (-1.E3 -1.E3 1.E3) VPAT1 LPAT1;
  12936. TRAC QUAL (1.E3 -1000. 1.E3) VPAT1 LPAT1;
  12937.  
  12938. *
  12939. * CALCUL DU FLUX MOYEN ET DE LA PUISSANCE
  12940. *****************************************
  12941. VFP1 = FLUX TAB1.'MODELF' VPAT1 ;
  12942. TAB1.V_SOM1 = (EXTR TAB1.LIS_FLUX (DIME TAB1.LIS_FLUX)) * (MAXI (RESU VFP1));
  12943. TAB1.V_FACFM2 = (MAXI (RESU VFP1)) / (MESU LPAT1) ;
  12944.  
  12945.  
  12946. MESS '---------------------------------> Sortie de @FLUX_3D';
  12947. FINPROC VPAT1;
  12948.  
  12949. **** @FRENET
  12950. *****************************************************************
  12951. * PROCEDURE FRENET : CALCUL DU REPERE DE FRENET LE LONG D'UNE LIGNE
  12952. *****************************************************************
  12953. DEBPROC @FRENET GEO*MAILLAGE MOT1/MOT OEIL1/POINT;
  12954. LOG1 = EXISTE MOT1;
  12955. GEO1 = CHAN SEG2 GEO ;
  12956. DIMGEO = VALEUR DIME ;
  12957. SI (DIMGEO > 2);
  12958. NEL = NBEL GEO1 ;
  12959. NP = NBNO GEO1 ;
  12960. IP = 1 ;
  12961. REPETER BOUC1 (NEL - 1) ;
  12962. IP = IP + 1 ;
  12963. * mess 'ip =' ip ;
  12964. EIP1 = GEO1 ELEM (IP - 1 ) ;
  12965. PI1 = EIP1 POIN INITIAL ;
  12966. EIP2 = GEO1 ELEM IP ;
  12967. PIP = EIP2 POIN INITIAL ;
  12968. PI2 = EIP2 POIN FINAL ;
  12969. LII = EIP1 ET EIP2 ;
  12970. V1 = MOIN PI1 PIP ;
  12971. V2 = MOIN PIP PI2 ;
  12972. V4 = V1 PVEC V2 ;
  12973. SI ((NORM V4) < ((NORM V1) * 1.E-5));
  12974. SI (IP < NEL);
  12975. INCR = IP;
  12976. REPETER BOUC2 ;
  12977. INCR = INCR + 1 ;
  12978. * MESS ' INCR = ' INCR;
  12979. ELE1 = GEO1 ELEM INCR ;
  12980. PT2 = ELE1 POIN FINAL ;
  12981. V22 = MOIN PIP PT2 ;
  12982. V42 = V1 PVEC V22 ;
  12983. SI ((NORM V42) > ((NORM V1) * 1.E-5)) ;
  12984. QUITTER BOUC2 ;
  12985. FINSI ;
  12986. SI (INCR EGA NEL) ;
  12987. V42 = V1 PVEC (1. 0. 0.) ;
  12988. SI ((NORM V42) > ((NORM V1) * 1.E-5)) ;
  12989. * MESS 'PERPENDICULAIRE A L AXE X';
  12990. QUITTER BOUC2 ;
  12991. SINON ;
  12992. V42 = V1 PVEC (0. -1. 0.) ;
  12993. * MESS 'PERPENDICULAIRE A L AXE Y';
  12994. QUITTER BOUC2 ;
  12995. FINSI ;
  12996. FINSI ;
  12997. FIN BOUC2 ;
  12998. V4 = V42 ;
  12999. SINON ;
  13000. * MESS ' DERNIER VECTEUR ';
  13001. V4 = BPI;
  13002. FINSI;
  13003. FINSI;
  13004. NV4 = NORM V4 ;
  13005. BPI = V4 * ( 1. / NV4 ) ;
  13006. CHBI = MANU CHPO PIP 3 'BX' (COOR 1 BPI) 'BY' (COOR 2 BPI) 'BZ' (COOR 3 BPI) NATURE DIFFUS;
  13007. V4 = BPI PVEC V1 ;
  13008. V5 = BPI PVEC V2 ;
  13009. V6 = V4 PLUS V5 ;
  13010. NPI = -1. * (V6/(NORM V6)) ;
  13011. CHNI = MANU CHPO PIP 3 'NX' (COOR 1 NPI) 'NY' (COOR 2 NPI) 'NZ' (COOR 3 NPI) NATURE DIFFUS;
  13012. TPI = NPI PVEC BPI ;
  13013. CHTI = MANU CHPO PIP 3 'TX' (COOR 1 TPI) 'TY' (COOR 2 TPI) 'TZ' (COOR 3 TPI) NATURE DIFFUS;
  13014. SI (EGA IP 2) ;
  13015. CHB = CHBI ;
  13016. CHN = CHNI ;
  13017. CHT = CHTI ;
  13018. SINON ;
  13019. CHB = CHB ET CHBI ;
  13020. CHN = CHN ET CHNI ;
  13021. CHT = CHT ET CHTI ;
  13022. FINSI ;
  13023. FIN BOUC1 ;
  13024. * MESS 'ELEMENT N0 1' ;
  13025. EI1 = GEO1 ELEM 1 ;
  13026. PI1 = EI1 POIN INITIAL ;
  13027. P2 = EI1 POIN FINAL ;
  13028. EL2 = GEO1 ELEM 2 ;
  13029. EL3 = GEO1 ELEM 3 ;
  13030. EL4 = GEO1 ELEM 4 ;
  13031. CHT2 = REDU CHT EL2 ;
  13032. CHT3 = REDU CHT EL3 ;
  13033. CHT4 = REDU CHT EL4 ;
  13034. CHN2 = REDU CHN EL2 ;
  13035. CHN3 = REDU CHN EL3 ;
  13036. CHN4 = REDU CHN EL4 ;
  13037. CHB2 = REDU CHB EL2 ;
  13038. CHB3 = REDU CHB EL3 ;
  13039. CHB4 = REDU CHB EL4 ;
  13040. DS2 R2 T2 ALPHA2 BETA2 = @COUTOR1 EL2 CHT2 CHN2 CHB2 ;
  13041. DS3 R3 T3 ALPHA3 BETA3 = @COUTOR1 EL3 CHT3 CHN3 CHB3 ;
  13042. DS4 R4 T4 ALPHA4 BETA4 = @COUTOR1 EL4 CHT4 CHN4 CHB4 ;
  13043. DS1 = NORM (MOIN PI1 P2) ;
  13044. RAP12 = (DS1+DS2)/2;
  13045. RAP23 = (DS2+DS3)/2;
  13046. RAP34 = (DS3+DS4)/2;
  13047. PR2 = (R3-R2)/RAP23;
  13048. PR3 = (R4-R3)/RAP34;
  13049. PT2 = (T3-T2)/RAP23;
  13050. PT3 = (T4-T3)/RAP34;
  13051. RAP = (DS1+(2*DS2)+DS3)/(DS2+(2*DS3)+DS4);
  13052. PR1 = PR2+((PR2-PR3)*RAP);
  13053. R1 = R2-(PR1*RAP12);
  13054. ALPHA1 = -1. * (DS1/R1)* (180. / PI);
  13055. SI (T2 > 1.E98);
  13056. BETA1 = 0. ;
  13057. FINSI ;
  13058. SI (T3 > 1.E98) ;
  13059. SI (T2 > 1.E98);
  13060. BETA1 = 0. ;
  13061. SINON ;
  13062. TT1 = (1./T2)*(1. + RAP) ;
  13063. T1 = 1./TT1 ;
  13064. BETA1 = (DS1/T1)*180/PI;
  13065. FINSI ;
  13066. FINSI ;
  13067. SI ((T2 < 1.E98) ET (T3 < 1.E98)) ;
  13068. PT1 = PT2+((PT2-PT3)*RAP);
  13069. T1 = T2-(PT1*RAP12);
  13070. BETA1 = (DS1/T1)*180./PI ;
  13071. FINSI ;
  13072. NXI2 = EXTR CHN NX P2 ;
  13073. NYI2 = EXTR CHN NY P2 ;
  13074. NZI2 = EXTR CHN NZ P2 ;
  13075. VN2 = NXI2 NYI2 NZI2 ;
  13076. TXI2 = EXTR CHT TX P2 ;
  13077. TYI2 = EXTR CHT TY P2 ;
  13078. TZI2 = EXTR CHT TZ P2 ;
  13079. VT2 = TXI2 TYI2 TZI2 ;
  13080. BXI2 = EXTR CHB BX P2 ;
  13081. BYI2 = EXTR CHB BY P2 ;
  13082. BZI2 = EXTR CHB BZ P2 ;
  13083. VB2 = BXI2 BYI2 BZI2 ;
  13084. VN = (VN2 * (COS BETA1)) PLUS (VB2 * (SIN BETA1)) ;
  13085. VB1 = (VN2 * (-1.*(SIN BETA1))) PLUS (VB2 * (COS BETA1)) ;
  13086. VT1 = (VT2 * (COS ALPHA1)) PLUS (VN * (SIN ALPHA1)) ;
  13087. VN1 = (VT2 * (-1.*(SIN ALPHA1))) PLUS (VN * (COS ALPHA1)) ;
  13088. CHTI = MANU CHPO PI1 3 'TX' (COOR 1 VT1) 'TY' (COOR 2 VT1) 'TZ' (COOR 3 VT1) NATURE DIFFUS;
  13089. CHT = CHT ET CHTI ;
  13090. CHNI = MANU CHPO PI1 3 'NX' (COOR 1 VN1) 'NY' (COOR 2 VN1) 'NZ' (COOR 3 VN1) NATURE DIFFUS;
  13091. CHN = CHN ET CHNI ;
  13092. CHBI = MANU CHPO PI1 3 'BX' (COOR 1 VB1) 'BY' (COOR 2 VB1) 'BZ' (COOR 3 VB1) NATURE DIFFUS;
  13093. CHB = CHB ET CHBI ;
  13094. * MESS 'ELEMENT N0 NEL' ;
  13095. EI1 = GEO1 ELEM NEL ;
  13096. PI1 = EI1 POIN FINAL ;
  13097. P2 = EI1 POIN INITIAL ;
  13098. EL2 = GEO1 ELEM (NEL-1) ;
  13099. EL3 = GEO1 ELEM (NEL-2) ;
  13100. EL4 = GEO1 ELEM (NEL-3) ;
  13101. CHT2 = REDU CHT EL2 ;
  13102. CHT3 = REDU CHT EL3 ;
  13103. CHT4 = REDU CHT EL4 ;
  13104. CHN2 = REDU CHN EL2 ;
  13105. CHN3 = REDU CHN EL3 ;
  13106. CHN4 = REDU CHN EL4 ;
  13107. CHB2 = REDU CHB EL2 ;
  13108. CHB3 = REDU CHB EL3 ;
  13109. CHB4 = REDU CHB EL4 ;
  13110. DS2 R2 T2 ALPHA2 BETA2 = @COUTOR1 EL2 CHT2 CHN2 CHB2 ;
  13111. DS3 R3 T3 ALPHA3 BETA3 = @COUTOR1 EL3 CHT3 CHN3 CHB3 ;
  13112. DS4 R4 T4 ALPHA4 BETA4 = @COUTOR1 EL4 CHT4 CHN4 CHB4 ;
  13113. DS1 = NORM (MOIN PI1 P2) ;
  13114. RAP12 = (DS1+DS2)/2;
  13115. RAP23 = (DS2+DS3)/2;
  13116. RAP34 = (DS3+DS4)/2;
  13117. PR2 = (R3-R2)/RAP23;
  13118. PR3 = (R4-R3)/RAP34;
  13119. PT2 = (T3-T2)/RAP23;
  13120. PT3 = (T4-T3)/RAP34;
  13121. RAP = (DS1+(2*DS2)+DS3)/(DS2+(2*DS3)+DS4);
  13122. PR1 = PR2+((PR2-PR3)*RAP);
  13123. R1 = R2-(PR1*RAP12);
  13124. ALPHA1 = (DS1/R1)*180./PI;
  13125. SI (T2 > 1.E98);
  13126. BETA1 = 0. ;
  13127. FINSI ;
  13128. SI (T3 > 1.E98) ;
  13129. SI (T2 > 1.E98);
  13130. BETA1 = 0. ;
  13131. SINON ;
  13132. TT1 = (1./T2)*(1. + RAP) ;
  13133. T1 = 1./TT1 ;
  13134. BETA1 = -1.*(DS1/T1)*180/PI;
  13135. FINSI ;
  13136. FINSI ;
  13137. SI ((T2 < 1.E98) ET (T3 < 1.E98)) ;
  13138. PT1 = PT2+((PT2-PT3)*RAP);
  13139. T1 = T2-(PT1*RAP12);
  13140. BETA1 = -1.*(DS1/T1)*180/PI ;
  13141. FINSI ;
  13142. NXI2 = EXTR CHN NX P2 ;
  13143. NYI2 = EXTR CHN NY P2 ;
  13144. NZI2 = EXTR CHN NZ P2 ;
  13145. VN2 = NXI2 NYI2 NZI2 ;
  13146. TXI2 = EXTR CHT TX P2 ;
  13147. TYI2 = EXTR CHT TY P2 ;
  13148. TZI2 = EXTR CHT TZ P2 ;
  13149. VT2 = TXI2 TYI2 TZI2 ;
  13150. BXI2 = EXTR CHB BX P2 ;
  13151. BYI2 = EXTR CHB BY P2 ;
  13152. BZI2 = EXTR CHB BZ P2 ;
  13153. VB2 = BXI2 BYI2 BZI2 ;
  13154. VT1 = ((VT2 * (COS ALPHA1)) PLUS (VN2 * (SIN ALPHA1))) ;
  13155. VN = (VT2 * (-1. * (SIN ALPHA1))) PLUS (VN2 * (COS ALPHA1)) ;
  13156. VB = VB2 ;
  13157. VN1 = (VN * (COS BETA1)) PLUS (VB * (SIN BETA1)) ;
  13158. VB1 = (VN * (-1. * (SIN BETA1))) PLUS (VB * (COS BETA1)) ;
  13159. CHTI = MANU CHPO PI1 3 'TX' (COOR 1 VT1) 'TY' (COOR 2 VT1) 'TZ' (COOR 3 VT1) NATURE DIFFUS;
  13160. CHT = CHT ET CHTI ;
  13161. CHNI = MANU CHPO PI1 3 'NX' (COOR 1 VN1) 'NY' (COOR 2 VN1) 'NZ' (COOR 3 VN1) NATURE DIFFUS;
  13162. CHN = CHN ET CHNI ;
  13163. CHBI = MANU CHPO PI1 3 'BX' (COOR 1 VB1) 'BY' (COOR 2 VB1) 'BZ' (COOR 3 VB1) NATURE DIFFUS;
  13164. CHB = CHB ET CHBI ;
  13165. COX COY COZ = COOR GEO ;
  13166. XMAX = MAXI COX ;
  13167. YMAX = MAXI COY ;
  13168. ZMAX = MAXI COZ ;
  13169. XMIN = MINI COX ;
  13170. YMIN = MINI COY ;
  13171. ZMIN = MINI COZ ;
  13172. DL = (((XMAX - XMIN)**2) + ((YMAX -YMIN)**2) + ((ZMAX -ZMIN)**2))**0.5 ;
  13173. AMP = DL/10. ;
  13174. VT = VECT CHT AMP TX TY TZ ROUGE ;
  13175. VN = VECT CHN AMP NX NY NZ VERT ;
  13176. VB = VECT CHB AMP BX BY BZ JAUNE ;
  13177. SI (LOG1 EGA VRAI);
  13178. TITRE 'REPERE DE FRENET DE LA LIGNE' ;
  13179. TRAC OEIL1 QUAL (VT ET VN ET VB) GEO1 ;
  13180. FINSI;
  13181. SINON ;
  13182. NEL = NBEL GEO1;
  13183. NP = NBNO GEO1;
  13184. O = 0. 0.;
  13185. IP = 1;
  13186. REPETER BOUC2 (NEL - 1);
  13187. IP =IP+1;
  13188. * MESS ' IP = ' IP;
  13189. EIP1 = GEO1 ELEM (IP-1);
  13190. PI1 = EIP1 POIN INITIAL ;
  13191. EIP2 = GEO1 ELEM IP ;
  13192. PIP = EIP2 POIN INITIAL ;
  13193. PI2 = EIP2 POIN FINAL ;
  13194. V1 = MOIN PIP PI1;
  13195. V2 = MOIN PI2 PIP;
  13196. V3 = V1 TOUR 90. O;
  13197. V4 = V2 TOUR 90. O;
  13198. V5 = V3 PLUS V4;
  13199. NPI = V5 / (NORM V5);
  13200. TPI = NPI TOUR (-1*90.) O;
  13201. CHNI = MANU CHPO PIP 2 'NX' (COOR 1 NPI) 'NY' (COOR 2 NPI) NATURE DIFFUS;
  13202. CHTI = MANU CHPO PIP 2 'TX' (COOR 1 TPI) 'TY' (COOR 2 TPI) NATURE DIFFUS;
  13203. SI (EGA IP 2) ;
  13204. CHN = CHNI ;
  13205. CHT = CHTI ;
  13206. SINON ;
  13207. CHN = CHN ET CHNI ;
  13208. CHT = CHT ET CHTI ;
  13209. FINSI;
  13210. CHB = MANU CHPO GEO1 2 'BX' 0. 'BY' 0. ;
  13211. FIN BOUC2;
  13212.  
  13213. * MESS 'ELEMENT N0 1' ;
  13214. EI1 = GEO1 ELEM 1 ;
  13215. PI1 = EI1 POIN INITIAL ;
  13216. P2 = EI1 POIN FINAL ;
  13217. EL2 = GEO1 ELEM 2 ;
  13218. EL3 = GEO1 ELEM 3 ;
  13219. EL4 = GEO1 ELEM 4 ;
  13220. CHT2 = REDU CHT EL2 ;
  13221. CHT3 = REDU CHT EL3 ;
  13222. CHT4 = REDU CHT EL4 ;
  13223. CHN2 = REDU CHN EL2 ;
  13224. CHN3 = REDU CHN EL3 ;
  13225. CHN4 = REDU CHN EL4 ;
  13226. CHB2 = REDU CHB EL2 ;
  13227. CHB3 = REDU CHB EL3 ;
  13228. CHB4 = REDU CHB EL4 ;
  13229. DS2 R2 T2 ALPHA2 BETA2 = @COUTOR1 EL2 CHT2 CHN2 CHB2 ;
  13230. DS3 R3 T3 ALPHA3 BETA3 = @COUTOR1 EL3 CHT3 CHN3 CHB3 ;
  13231. DS4 R4 T4 ALPHA4 BETA4 = @COUTOR1 EL4 CHT4 CHN4 CHB4 ;
  13232. DS1 = NORM (MOIN PI1 P2) ;
  13233. RAP12 = (DS1+DS2)/2;
  13234. RAP23 = (DS2+DS3)/2;
  13235. RAP34 = (DS3+DS4)/2;
  13236. PR2 = (R3-R2)/RAP23;
  13237. PR3 = (R4-R3)/RAP34;
  13238. RAP = (DS1+(2*DS2)+DS3)/(DS2+(2*DS3)+DS4);
  13239. PR1 = PR2+((PR2-PR3)*RAP);
  13240. R1 = R2-(PR1*RAP12);
  13241. ALPHA1 = -1. * (DS1/R1)* (180. / PI);
  13242. NXI2 = EXTR CHN NX P2 ;
  13243. NYI2 = EXTR CHN NY P2 ;
  13244. VN2 = NXI2 NYI2 ;
  13245. TXI2 = EXTR CHT TX P2 ;
  13246. TYI2 = EXTR CHT TY P2 ;
  13247. VT2 = TXI2 TYI2 ;
  13248. BXI2 = EXTR CHB BX P2 ;
  13249. BYI2 = EXTR CHB BY P2 ;
  13250. VB2 = BXI2 BYI2 ;
  13251. VT1 = (VT2 * (COS ALPHA1)) PLUS (VN2 * (SIN ALPHA1)) ;
  13252. VN1 = (VT2 * (-1. * (SIN ALPHA1))) PLUS (VN2 * (COS ALPHA1)) ;
  13253. VB = VB2 ;
  13254. CHTI = MANU CHPO PI1 2 'TX' (COOR 1 VT1) 'TY' (COOR 2 VT1) NATURE DIFFUS;
  13255. CHT = CHT ET CHTI ;
  13256. CHNI = MANU CHPO PI1 2 'NX' (COOR 1 VN1) 'NY' (COOR 2 VN1) NATURE DIFFUS;
  13257. CHN = CHN ET CHNI ;
  13258.  
  13259. * MESS 'ELEMENT N0 NEL' ;
  13260. EI1 = GEO1 ELEM NEL ;
  13261. PI1 = EI1 POIN FINAL ;
  13262. P2 = EI1 POIN INITIAL ;
  13263.  
  13264. EL2 = GEO1 ELEM (NEL-1) ;
  13265. EL3 = GEO1 ELEM (NEL-2) ;
  13266. EL4 = GEO1 ELEM (NEL-3) ;
  13267. CHT2 = REDU CHT EL2 ;
  13268. CHT3 = REDU CHT EL3 ;
  13269. CHT4 = REDU CHT EL4 ;
  13270. CHN2 = REDU CHN EL2 ;
  13271. CHN3 = REDU CHN EL3 ;
  13272. CHN4 = REDU CHN EL4 ;
  13273. CHB2 = REDU CHB EL2 ;
  13274. CHB3 = REDU CHB EL3 ;
  13275. CHB4 = REDU CHB EL4 ;
  13276. DS2 R2 T2 ALPHA2 BETA2 = @COUTOR1 EL2 CHT2 CHN2 CHB2 ;
  13277. DS3 R3 T3 ALPHA3 BETA3 = @COUTOR1 EL3 CHT3 CHN3 CHB3 ;
  13278. DS4 R4 T4 ALPHA4 BETA4 = @COUTOR1 EL4 CHT4 CHN4 CHB4 ;
  13279. DS1 = NORM (MOIN PI1 P2) ;
  13280. RAP12 = (DS1+DS2)/2;
  13281. RAP23 = (DS2+DS3)/2;
  13282. RAP34 = (DS3+DS4)/2;
  13283. PR2 = (R3-R2)/RAP23;
  13284. PR3 = (R4-R3)/RAP34;
  13285. RAP = (DS1+(2*DS2)+DS3)/(DS2+(2*DS3)+DS4);
  13286. PR1 = PR2+((PR2-PR3)*RAP);
  13287. R1 = R2-(PR1*RAP12);
  13288. ALPHA1 = (DS1/R1)*180./PI;
  13289. NXI2 = EXTR CHN NX P2 ;
  13290. NYI2 = EXTR CHN NY P2 ;
  13291. VN2 = NXI2 NYI2 ;
  13292. TXI2 = EXTR CHT TX P2 ;
  13293. TYI2 = EXTR CHT TY P2 ;
  13294. VT2 = TXI2 TYI2 ;
  13295. VT1 = ((VT2 * (COS ALPHA1)) PLUS (VN2 * (SIN ALPHA1))) ;
  13296. VN1 = (VT2 * (-1. * (SIN ALPHA1))) PLUS (VN2 * (COS ALPHA1)) ;
  13297. CHTI = MANU CHPO PI1 2 'TX' (COOR 1 VT1) 'TY' (COOR 2 VT1) NATURE DIFFUS;
  13298. CHT = CHT ET CHTI ;
  13299. CHNI = MANU CHPO PI1 2 'NX' (COOR 1 VN1) 'NY' (COOR 2 VN1) NATURE DIFFUS;
  13300. CHN = CHN ET CHNI ;
  13301.  
  13302. COX COY = COOR GEO ;
  13303. XMAX = MAXI COX ;
  13304. YMAX = MAXI COY ;
  13305. XMIN = MINI COX ;
  13306. YMIN = MINI COY ;
  13307. DL = (((XMAX - XMIN)**2) + ((YMAX -YMIN)**2))**0.5 ;
  13308. AMP = DL/10. ;
  13309. VT = VECT CHT AMP TX TY ROUGE ;
  13310. VN = VECT CHN AMP NX NY VERT ;
  13311. SI (LOG1 EGA VRAI);
  13312. TITRE 'REPERE DE FRENET DE LA LIGNE' ;
  13313. TRAC QUAL (VN ET VT) GEO1;
  13314. FINSI;
  13315. FINSI ;
  13316. FINPROC CHT CHN CHB ;
  13317. **** @FRENETT
  13318. 'DEBPROC' @FRENETT LIGN_1*MAILLAGE ;
  13319. MESS '----------------------> entree dans @FRENETT ';
  13320. V1 = VALEUR DIME ;
  13321. SI( V1 EGA 2 ) ;
  13322. * CHT CHN CHB = @FRENET LIGN_1 'TRACE' ;
  13323. CHT CHN CHB = @FRENET LIGN_1 ;
  13324. CHPP = CHT ET CHN ;
  13325. SINON ;
  13326. * CHT CHN CHB = @FRENET LIGN_1 'TRACE' (0. 0. 1000.);
  13327. CHT CHN CHB = @FRENET LIGN_1 ;
  13328. CHPP = CHT ET CHN ET CHB ;
  13329. FINSI ;
  13330. MESS '----------------------> sortie de @FRENETT ';
  13331. 'FINPROC' CHPP;
  13332. **** FROTTER
  13333. *---------------------------------------------------------------------
  13334. * PROCEDURE FROTTER VERSION DU 15/11/87
  13335. * MODIFICATION RECUE LE 22/09/1992
  13336. *---------------------------------------------------------------------
  13337. * CETTE PROCEDURE SERT A CALCULER LE CONTACT AVEC FROTTEMENT
  13338. *
  13339. * SYNTAXE :
  13340. * -------
  13341. *
  13342. *
  13343. * SOL RE = FROTTER RIG FOR BLOCAG COEF ;
  13344. *
  13345. * RIG : LA RIGIDITE AVEC SES BLOCAGES AUTRES QUE UNILATERAUX
  13346. * ET DE FROTTEMENT
  13347. * FOR : LE VECTEUR SECOND MEMBRE
  13348. * BLOCAG : LES BLOCAGES UNILATERAUX ET DE FROTTEMENT
  13349. * COEF : LES COEFFICIENTS DE FROTTEMENT
  13350. *
  13351. * EN SORTIE : DE : LA SOLUTION
  13352. * RE : LES REACTIONS D'APPUIS
  13353. * RIAD
  13354. *
  13355. *---------------------------------------------------------------------
  13356. *
  13357. DEBPROC FROTTER ZR*RIGIDITE FFF*CHPOINT BBN*RIGIDITE BBT*RIGIDITE ZCOEF*CHPOINT ZEZE*MAILLAGE IPAPA*ENTIER;
  13358. *
  13359. *----------------------------------------------------------------------
  13360. *
  13361. *--------------------
  13362. * INITIALISATIONS
  13363. *--------------------
  13364. *
  13365. MAXIT = 10 ;
  13366. *----------------------- MILL 16 / 4 /92
  13367. *ZPREC1 = 1.E-8;
  13368. *ZPREC2 = 1.E-4 ;
  13369. ZPREC1 = 1.E-10;
  13370. ZPREC2 = 1.E-8 ;
  13371. *-----------------------
  13372. GEOT= EXTRAI BBT MAIL MULT ;
  13373. BBB = BBN ET BBT ;
  13374. *MESS ' LES NOEUDS ASSOCIES A BBN ' ;NOBBN =EXTRAI BBN MAIL MULT ;
  13375. *LIST NOBBN;
  13376. *MESS ' LES NOEUDS ASSOCIES A BBT ' ;NOBBT =EXTRAI BBT MAIL MULT ;
  13377. *LIST NOBBT;
  13378. SSDIM = VALEUR DIME ;
  13379. SI ( EGA SSDIM 3 ) ;
  13380. OEIL = -1000 -1500 20000 ;
  13381. FINSI ;
  13382. *
  13383. *------------------------------
  13384. * CALCUL DU SUPER ELEMENT
  13385. *------------------------------
  13386. *
  13387. SUP = SUPER RIGI ZR BBB ;
  13388. STAT = VRAI ;
  13389. RISUP = EXTRAI SUP RIGI;
  13390. FFF0= DEPIMP BBB 0.; FA = FFF ET FFF0;
  13391. *MESS ' VECTEUR FFF EN ENTREE DE FROTTER ' ;
  13392. *LIST FFF ;
  13393. F = SUPER CHAR SUP FA ;
  13394. *MESS ' VECTEUR F SORTI DE SUPER ' ; LIST F ;
  13395.  
  13396. DETR FFF0 GEOM ;
  13397. *
  13398. *-----------------------
  13399. * INITIALISATIONS
  13400. *-----------------------
  13401. *
  13402. ITER = 0 ;
  13403. NCONV = VRAI ;
  13404. FROT = MANU CHPO GEOT 2 FX 0. FY 0. ;
  13405. DE = MANU CHPO GEOT 2 UX 0. UY 0. ;
  13406. DEPTOT = FA EXCO FLX FLX ;
  13407. *MESS ' DEPTOT ' ; LIST DEPTOT ;
  13408. FDEPTO = F ET DEPTOT ;
  13409. *MESS ' VOICI FDEPTO ' ; LIST FDEPTO ;
  13410. RITOU = RISUP ET BBB ;
  13411. * INITIALISER LISEA A UNE VALEUR IMPOSSIBLE
  13412. LISEA = LECT -1;
  13413. FDEPTOT=F ;
  13414. *MESS ' ON MOYENNE LES FORCES DE FROTTEMENT ' ;
  13415. *
  13416. *---------------
  13417. * ITERATIONS
  13418. *---------------
  13419. *
  13420. SAUTER 2 LIGNE ;
  13421. REPETER BOUCL1 MAXIT ;
  13422. ITER = ITER + 1 ;
  13423. MESS ' PROCEDURE FROTTER - ITERATION NUMERO ' ITER ;
  13424. FPRES = FROT ;
  13425. DRES = DE ;
  13426. *MESS ' ON ATTAQUE LA RESOLUTION ' ;
  13427. *MESS ' VOICI LES FORCES ' ; LIST FDEPTOT ;
  13428. *MESS ' VOICI LES RAIDEURS ' ; LIST RITOU ;
  13429.  
  13430. DE=RESOU NOID NOUNIL RITOU FDEPTOT;
  13431.  
  13432. *MESS ' VOICI LA SOLUTION SORTIE DE RESOU ' ; LIST DE ;
  13433. *
  13434. * ICI L'ACCELERATION DE CONVERGENCE
  13435. * ELLE SEMBLE UN PEU FOIREUSE PAR MOMENTS
  13436. *
  13437. SI ('MULT' ITER 5 ) ;
  13438. * SI ('MULT' ITER 30000) ;
  13439. SI NCONVT ;
  13440. SI LENEW;
  13441. ZDP1= 'ACTI' 'GEOM' ZDEPN2 ZDEPN1 DE;
  13442. 'DETR' DE ;
  13443. DE = ZDP1 ;
  13444. FINSI ;
  13445. FINSI ;
  13446. FINSI ;
  13447. 'SI' (ITER > 1 ) ;
  13448. 'SI' ( ITER > 2 ) ; 'DETR' ZDEPN2 'GEOM' ; 'FINSI';
  13449. ZDEPN2 = ZDEPN1 ;
  13450. 'FINSI' ;
  13451. ZDEPN1 = 'COPIER' DE 'GEOM' ;
  13452.  
  13453. *MESS ' LES DEPLACEMENTS ' ; LIST DE ;
  13454. *MESS ' FORCES NORMALES ' ; LIST ( REDU DE NOBBN);
  13455. *MESS ' FORCES TANGENTES' ; LIST ( REDU DE NOBBT);
  13456. *
  13457. * PETIT DESSIN
  13458. *
  13459. VV =VECTEUR FDEPTOT 0.1 FX FY VERT;
  13460. *DEF0=DEFOR ZEZE DE 0 BLEU;
  13461. *DEF1=DEFOR ZEZE DE 10 VV ROSE;
  13462. *TRAC ( DEF0 ET DEF1 ) ;
  13463. * OPTI DONN 5 ;
  13464. *MESS ' ON APPELLE GLISSER ' ;
  13465. *MESS ' ON IMPRIME BBB ' ; LIST BBB ;
  13466. *OPTI IMPI 528 ;
  13467. *OPTI IMPI 530 ;
  13468. SI ( >EG IPAPA 7);
  13469. *OPTI IMPI 530 ;
  13470. * OPTI IMPI 528 ;
  13471. FINSI;
  13472. *BLOTO RIAD LISEN FROTB = BBB GLISSER DE DEPTOT FPRES ZCOEF ;
  13473. BLOTO RIAD LISEN FROT = BBB GLISSER DE DEPTOT FPRES ZCOEF ;
  13474. OPTI IMPI 0 ;
  13475. *MESS ' ON IMPRIME BLOTO ' ; LIST BLOTO ;
  13476. *FROT = ( FROTB + FPRES ) / 2. ;
  13477. *MESS ' LES FORCES DE FROTTEMENT FROT ' ; LIST FROT ;
  13478. SI ( EGA SSDIM 3 ) ;
  13479.  
  13480. *$$ON ESSAYE DE TRACER CES FORCES
  13481. *VV1 =VECTEUR FROTB 0.1 FX FY FZ VERT;
  13482. VV1 =VECTEUR FROT 0.1 FX FY FZ VERT;
  13483. *VV2 =VECTEUR FROT 0.1 FX FY FZ ROUG;
  13484. *VV3 =VECTEUR FPRES 0.1 FX FY FZ JAUN;
  13485. *DEF10=DEFOR ZEZE DE 0 VV1 BLEU ;
  13486. *DEF1=DEFOR ZEZE DE 0 VV1 BLEU ;
  13487. *DEF2=DEFOR ZEZE DE 0 VV2 TURQ ;
  13488. *DEF3=DEFOR ZEZE DE 0 VV3 ROSE ;
  13489. *TRAC OEIL ( DEF1 ET DEF2 ET DEF3 ) ;
  13490. *TRAC OEIL DEF1 ;
  13491. FINSI ;
  13492.  
  13493. SI ( EGA SSDIM 2 ) ;
  13494.  
  13495. VV1 =VECTEUR FROT 1 FX FY VERT;
  13496. *DEF10=DEFOR ZEZE DE 0 BLEU ;
  13497. *DEF1=DEFOR ZEZE DE VV1 TURQ ;
  13498. *DEF2=DEFOR ZEZE DE 0 VV2 TURQ ;
  13499. *DEF3=DEFOR ZEZE DE 0 VV3 ROSE ;
  13500. *TRAC OEIL ( DEF1 ET DEF2 ET DEF3 ) ;
  13501. *TRAC ( DEF1 ET DEF10) ;
  13502. FINSI ;
  13503. OPTI IMPI 0 ;
  13504. *-----------------------------
  13505. * TESTS DE CONVERGENCE
  13506. *-----------------------------
  13507. * D'ABORD SUR LES CONTACTS
  13508. *-----------------------------
  13509. NCONVT = FAUX ;
  13510. SI (LISEN EGA LISEA) ;
  13511. MESS ' ON A CONVERGE LES CONTACTS ' ;
  13512. NCONVT = VRAI ;
  13513. FINSI;
  13514. *-------------------------------------------------------------
  13515. * ENSUITE SUR LES FORCES DE FROTTEMENT ET LES DEPLACEMENTS
  13516. *-------------------------------------------------------------
  13517. SI NCONVT;
  13518. LENEW=FAUX;
  13519. *
  13520. * TEST SUR LES FORCES DE FROTTEMENT
  13521. *
  13522. FDIFF = FROT - FPRES ;
  13523. *MESS ' La difference sur les forces de frottement';
  13524. *list fdiff;
  13525. DENOM= XTX FROT ;
  13526. SI ( EGA DENOM 0. ) ;
  13527. KRIT1 = ABS ( ( XTX FDIFF ) );
  13528. SINON ;
  13529. KRIT1 = ABS ( ( XTX FDIFF ) / DENOM ) ;
  13530. FINSI ;
  13531. MESS ' ITERATION ' ITER ' CRITERE 1 ' KRIT1 ;
  13532. SI ( KRIT1 < ZPREC1 ) ;
  13533. LENEW=VRAI;
  13534. *
  13535. * TEST SUR LES DEPLACEMENTS
  13536. *
  13537. FDIFF = DE - DRES;
  13538. FDIFF = ENLEVER FDIFF 'LX' ;
  13539. * MESS ' La difference sur les deplacements';
  13540. *list fdiff;
  13541. DENOM= XTX DE ;
  13542. SI ( EGA DENOM 0. ) ;
  13543. KRIT2= ABS ( ( XTX FDIFF ) );
  13544. SINON ;
  13545. KRIT2 = ABS ( ( XTX FDIFF ) / DENOM ) ;
  13546. FINSI ;
  13547. MESS ' ITERATION ' ITER ' CRITERE 2 ' KRIT2 ;
  13548. *
  13549. SI ( KRIT2 < ZPREC2) ;
  13550. NCONV = FAUX ;
  13551. DETR LISEN ;
  13552. GFO=EXTRAI BLOTO MAIL;DETR GFO TOUT;
  13553. DETR BLOTO ELEM ;
  13554. QUITTER BOUCL1 ;
  13555. FINSI ;
  13556. FINSI ;
  13557. FINSI ;
  13558. *
  13559. DETRUIRE RITOU; DETRUIRE LISEA;
  13560. SI (ITER NEG 1);GFO=EXTRAI BLOTT MAIL;DETR GFO TOUT;
  13561. DETR BLOTT ELEM ; FINSI ;
  13562. *---------------------- MILL 16/4/92
  13563. RITOU = RISUP ET BLOTO ;
  13564. * RITOU = RISUP ET BLOTO ET RIAD ;
  13565. *----------------------
  13566. BLOTT= BLOTO;
  13567. LISEA=LISEN;
  13568. *---------------------- MILL 16/4/92
  13569. *MESS ' VOICI FROT ' ; LIST FROT ;
  13570. FDEPTOT=FDEPTO ET FROT ;
  13571. *----------------------
  13572. *
  13573. * ON SUPPRIME LA GESTION DES JEUX SUR LES NOEUDS DES BLOCAGES
  13574. * DE FROTTEMENT
  13575. *---------------------- MILL 16/4/92
  13576. * FDEPTOT= FDEPTO - ( REDU FDEPTO GEOT ) ;
  13577. *----------------------
  13578. * ON REMET LA GESTION DES JEUX SUR LES NOEUDS DES BLOCAGES
  13579. * DE FROTTEMENT MAIS EN PLUS SUBTIL
  13580. * DU COUP CA MARCHE POUR LES INCREMENTS DE FORCE NULS,
  13581. * MAIS CA NE MARCHERA PAS EN CAS DE DEPLACEMENT IMPOSE
  13582. * ASSOCIE A UNE CONDITION DE BLOCAGE AVEC FROTTEMENT
  13583. *
  13584. *---------------------- MILL 18/9/92
  13585. FDEPTOT= FDEPTOT - ( REDU DEPTOT GEOT ) ;
  13586. *----------------------
  13587. FIN BOUCL1;
  13588. *
  13589. * ON FAIT UN PEU DE MENAGE
  13590. *
  13591. MENAGE;
  13592. *
  13593. SI NCONV ;
  13594. MESS ' IL N Y A PAS DE SOLUTION AU SYSTEME ';
  13595. RITOU = RISUP ET BBB ;
  13596. LISEA = LECT 0;
  13597. SINON;
  13598. *
  13599. MESS ' CONVERGENCE EN' ITER 'ITERATIONS DANS LA RESOLUTION DES CONTACTS AVES FROTTEMENT ' ;
  13600. *
  13601. *-----------------------------------
  13602. * CALCUL SUR TOUTE LA STRUCTURE
  13603. *-----------------------------------
  13604. *
  13605. RIINT = EXTRAI SUP RIGT ;
  13606. DP = SUPER DEPL SUP DE;
  13607. DPFFF=DP ET FFF ET FROT ;
  13608. MESS ' RETOUR DANS TOUTE LA STRUCTURE ' ;
  13609. DE1 = RESOU NOUNIL NOID RIINT DPFFF ; DE3 =DE1 EXCO LX NOID LX;
  13610. RE1= DE EXCO LX NOID LX ; DE4 = DE3 * -1;
  13611. DE5 = QULX DE1 ZR ;
  13612. DE2=DE1 ET RE1 ET DE4 ET DE5 ; DETR DE3; DETR DE4 GEOM;
  13613. DETRUIRE DE1; DETRUIRE RE1 GEOM; DETRUIRE DPFFF GEOM;
  13614. DETRUIRE DP GEOM ; DETR DE5 GEOM;
  13615. *
  13616. * LES REACTIONS
  13617. *
  13618. RE2 = ( REAC RITOU DE ) ET FROT ;
  13619. *
  13620. FINSI ;
  13621. *
  13622. DETRUIRE F GEOM;DETRUIRE DEPTOT GEOM;DETR DE;
  13623. SI ( NEG ITER 1 ) ;
  13624. DETRUIRE FDEPTOT GEOM ;
  13625. FINSI ;
  13626. DETR FA GEOM;
  13627. *
  13628. FINPRO DE2 RE2 FROT RIAD;
  13629.  
  13630.  
  13631.  
  13632.  
  13633. **** HELICE
  13634. ******************************************************
  13635. * PROCEDURE HELICE DE MAILLAGE EN HELICE
  13636. ******************************************************
  13637. DEBPROC HELICE P1/POINT GEO1/MAILLAGE TYP1*MOT P0*POINT V0*POINT PAS*FLOTTANT ALPHA*FLOTTANT NP*ENTIER ;
  13638. DALPHA = ALPHA / NP ;
  13639. DVT = (V0 / (NORM V0)) * (DALPHA / 360.) * PAS ;
  13640. *------------------------------------------------
  13641. * CAS OU LA BASE EST UN POINT
  13642. *------------------------------------------------
  13643. SI (EGA TYP1 'POIN') ;
  13644. PF1 = P1 ;
  13645. IB = 0 ;
  13646. REPETER BOUC1 NP ;
  13647. IB = IB + 1 ;
  13648. PI1 = PF1 ;
  13649. PF1 = (PI1 PLUS DVT) TOUR DALPHA P0 (P0 PLUS V0) ;
  13650. LIG1 = DROIT 1 PI1 PF1 ;
  13651. SI (EGA IB 1) ;
  13652. GEO3 = LIG1 ;
  13653. SINON ;
  13654. GEO3 = GEO3 ET LIG1 ;
  13655. FINSI ;
  13656. FIN BOUC1 ;
  13657. GEO2 = PF1 ;
  13658. FINSI ;
  13659. *------------------------------------------------
  13660. * CAS OU LA BASE EST UNE LIGNE
  13661. *------------------------------------------------
  13662. SI (EGA TYP1 'LIGN') ;
  13663. LIGF1 = GEO1 ;
  13664. IB = 0 ;
  13665. REPETER BOUC2 NP ;
  13666. IB = IB + 1 ;
  13667. LIGI1 = LIGF1 ;
  13668. LIGF1 = (LIGI1 PLUS DVT) TOUR DALPHA P0 (P0 PLUS V0) ;
  13669. * S1 = DALL1 1 LIGI1 LIGF1 ;
  13670. S1 = LIGI1 REGLER 1 LIGF1 ;
  13671. SI (EGA IB 1) ;
  13672. GEO3 = S1 ;
  13673. SINON ;
  13674. GEO3 = GEO3 ET S1 ;
  13675. FINSI ;
  13676. FIN BOUC2 ;
  13677. GEO2 = LIGF1 ;
  13678. FINSI ;
  13679. *------------------------------------------------
  13680. * CAS OU LA BASE EST UNE SURFACE
  13681. *------------------------------------------------
  13682. SI (EGA TYP1 'SURF') ;
  13683. SUF1 = GEO1 ;
  13684. IB = 0 ;
  13685. REPETER BOUC3 NP ;
  13686. IB = IB + 1 ;
  13687. SUI1 = SUF1 ;
  13688. SUF1 = (SUI1 PLUS DVT) TOUR DALPHA P0 (P0 PLUS V0) ;
  13689. V1 = SUI1 VOLU 1 SUF1 ;
  13690. SI (EGA IB 1) ;
  13691. GEO3 = V1 ;
  13692. SINON ;
  13693. GEO3 = GEO3 ET V1 ;
  13694. FINSI ;
  13695. FIN BOUC3 ;
  13696. GEO2 = SUF1 ;
  13697. FINSI ;
  13698. FINPROC GEO2 GEO3;
  13699. ****************************************************************
  13700. **** @IMPR
  13701. DEBPROC @IMPR PHRASE/TEXT NREEL/FLOTTANT NENTIER/ENTIER;
  13702. OPTI ECHO 0 ;
  13703. OPTI IMPR 26 ;
  13704. SI (EXISTE PHRASE);
  13705. MESS PHRASE;
  13706. FINSI ;
  13707. SI (EXISTE NREEL );
  13708. MESS NREEL ;
  13709. FINSI ;
  13710. SI (EXISTE NENTIER );
  13711. MESS NENTIER;
  13712. FINSI ;
  13713. OPTI IMPR 6 ;
  13714. OPTI ECHO 1 ;
  13715. FINPROC ;
  13716. **** @INCI
  13717. DEBPROC @INCI TAB1*TABLE;
  13718. *
  13719. *****************************************************************
  13720. * PROCEDURE DE DETERMINATION DE L'ANGLE D'INCIDENCE MAX : ALPHA *
  13721. *****************************************************************
  13722. *
  13723. MESS '---------------------------------> calling @INCI';
  13724. MESS 'Calcul de l angle d incidence par le code';
  13725. *
  13726. *--------------- VARIABLES D'ENTREE :
  13727. MAIL0 = TAB1.<V_OMBRANT_N ;
  13728. CONT0 = TAB1.<S_OMBRANT_N ;
  13729. TYPCAL = TAB1.<TYPE_CALCUL ;
  13730. *------------------------------------
  13731. *
  13732. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  13733. ISHIFT = VRAI ;
  13734. IRIPPLE = VRAI ;
  13735. FINSI ;
  13736. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  13737. ISHIFT = VRAI ;
  13738. IRIPPLE = FAUX ;
  13739. FINSI ;
  13740. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  13741. ISHIFT = FAUX ;
  13742. IRIPPLE = VRAI ;
  13743. FINSI ;
  13744. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  13745. ISHIFT = FAUX ;
  13746. IRIPPLE = FAUX ;
  13747. FINSI ;
  13748. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  13749. ERRE ' >>>> @INCI : check the value of TAB1.<TYPE_CALCUL';
  13750. FINSI ;
  13751. *
  13752. *
  13753. *---- coordonnees dans le repere du maillage
  13754. XM = COOR 1 CONT0 ;
  13755. YM = COOR 2 CONT0 ;
  13756. SI ((VALEUR DIME) EGA 2) ;
  13757. ZM = XM * 0. ;
  13758. SINON ;
  13759. ZM = COOR 3 CONT0 ;
  13760. FINSI ;
  13761. *
  13762. *---- coordonnees dans le repere global
  13763. XG YG ZG = @CRMGC XM YM ZM TAB1 ;
  13764. MENAGE ;
  13765. *
  13766. *---- calcul du champ magnetique dans le repere global
  13767. BXG BYG BZG FSECU = @CHAMB TAB1 XG YG ZG ISHIFT IRIPPLE ;
  13768. MENAGE ;
  13769. *
  13770. *---- composantes de B dans le repere du maillage
  13771. BXM BYM BZM = @CBGMV BXG BYG BZG TAB1 ;
  13772. MENAGE ;
  13773. *
  13774. *---- calcul des normales a la surface calculees
  13775. *---- dans le repere du maillage
  13776. MESS 'APPEL DE VNORM3D POUR LE MAILLAGE OMBRANT';
  13777. NXM NYM NZM = @VNORM3D MAIL0 CONT0 ;
  13778. MENAGE ;
  13779. *
  13780. *---- calcul du produit scalaire et de l'angle d'incidence
  13781. B_NORM = ((BXM*BXM) + (BYM*BYM) + (BZM*BZM))**0.5 ;
  13782. VBVN = (ABS ((BXM*NXM) + (BYM*NYM) + (BZM*NZM))) / B_NORM;
  13783. ANGINCI = ATG ((1.-(VBVN**2))**0.5) VBVN ;
  13784. *
  13785. CHALPHA = ABS (90. - ANGINCI) ;
  13786. ALPHA = MAXI CHALPHA ;
  13787. MESS '>@INCI> Incidence maximale en degres :'ALPHA ;
  13788.  
  13789. MESS '---------------------------------> exiting @INCI';
  13790. FINPROC ALPHA ;
  13791. debproc @inertid geo1*maillage point1*point point2*point ;
  13792.  
  13793. *
  13794. * --- definition d'un modele articifiel pour les mchaml
  13795. *
  13796. mod1 = MODE geo1 mecanique elastique ;
  13797. *
  13798. * --- definition des champs de coordonnees
  13799. *
  13800. chpx1 = nomc scal (coor 1 geo1) ;
  13801. chpy1 = nomc scal (coor 2 geo1) ;
  13802. *
  13803. * ---
  13804. *
  13805. chmx2 = chan cham chpx1 geo1 bidon ;
  13806. chmy2 = chan cham chpy1 geo1 bidon ;
  13807. *
  13808. * ---
  13809. *
  13810. chmx1 = chan gravite mod1 chmx2 ;
  13811. chmy1 = chan gravite mod1 chmy2 ;
  13812. *
  13813. * --- aa1, bb1 et cc1 sont les coeffcients de l'equation cartesienne
  13814. * de la droite passant par point1 et point2
  13815. *
  13816. x1 = coor 1 point1 ;
  13817. y1 = coor 2 point1 ;
  13818. x2 = coor 1 point2 ;
  13819. y2 = coor 2 point2 ;
  13820.  
  13821. si (ega x1 x2 ) ;
  13822. si (ega y1 y2) ;
  13823. erre '>@inertie> les deux points sont confondus';
  13824. sinon ;
  13825. aa1 = 1. ;
  13826. bb1 = 0. ;
  13827. cc1 = -1. * x1 ;
  13828. finsi ;
  13829. sinon ;
  13830. aa1 = 1./(x2 - x1);
  13831. si (ega y1 y2) ;
  13832. aa1 = 0. ;
  13833. bb1 = 1. ;
  13834. cc1 = -1. * y1 ;
  13835. sinon ;
  13836. bb1 = -1./(y2 - y1);
  13837. cc1 = (x1 * aa1) + (x2 * bb1) * -1.;
  13838. finsi ;
  13839. finsi ;
  13840.  
  13841. cc2 = manu chml mod1 scal cc1 type bidon gravite;
  13842. den1 = ((aa1*aa1)+(bb1*bb1))**.5 ;
  13843. *
  13844. * --- chmd1 est le mchaml qui contient la distance des centres
  13845. * de gravite des elements de geo1 a la droite passant par
  13846. * point1 et point2
  13847. *
  13848. chmd1 = (abs((chmx1*aa1) + (chmy1*bb1) + cc2))/den1 ;
  13849. *
  13850. * --- intergration du carre du champs
  13851. *
  13852. i1 = intg mod1 (chmd1 ** 2.) ;
  13853.  
  13854. finproc i1 ;
  13855.  
  13856. debproc @inertie geo1*maillage vec1*point ;
  13857.  
  13858. *
  13859. * --- definition d'un modele articifiel pour les mchaml
  13860. *
  13861. mod1 = MODE geo1 mecanique elastique ;
  13862. *
  13863. * --- definition des champs de coordonnees
  13864. *
  13865. chpx1 = nomc scal (coor 1 geo1) ;
  13866. chpy1 = nomc scal (coor 2 geo1) ;
  13867. *
  13868. * ---
  13869. *
  13870. chmx2 = chan cham chpx1 geo1 bidon ;
  13871. chmy2 = chan cham chpy1 geo1 bidon ;
  13872. *
  13873. * ---
  13874. *
  13875. chmx1 = chan gravite mod1 chmx2 ;
  13876. chmy1 = chan gravite mod1 chmy2 ;
  13877. *
  13878. * --- on calcule la position du centre de gravite de la section
  13879. *
  13880. ss1 = mesu geo1 ;
  13881. gx1 = (intg mod1 chmx1) / ss1 ;
  13882. gy1 = (intg mod1 chmy1) / ss1 ;
  13883.  
  13884.  
  13885.  
  13886. *
  13887. * --- aa1, bb1 et cc1 sont les coeffcients de l'equation cartesienne
  13888. * de la droite passant par point1 et point2
  13889. *
  13890. x2 = coor 1 vec1 ;
  13891. y2 = coor 2 vec1 ;
  13892.  
  13893. aa1 = y2 ;
  13894. bb1 = -1. * x2 ;
  13895. cc1 = x2 * gx1 - (y2 * gx1) ;
  13896. cc2 = manu chml mod1 scal cc1 type bidon gravite;
  13897. den1 = ((aa1*aa1)+(bb1*bb1))**.5 ;
  13898. *
  13899. * --- chmd1 est le mchaml qui contient la distance des centres
  13900. * de gravite des elements de geo1 a la droite passant par
  13901. * le centre de gravite et la direction definie par le vecteur1
  13902. *
  13903. chmd1 = (abs((chmx1*aa1) + (chmy1*bb1) + cc2))/den1 ;
  13904. *
  13905. * --- intergration du carre du champs
  13906. *
  13907. i1 = intg mod1 (chmd1 ** 2.) ;
  13908.  
  13909. finproc (gx1 gy1) i1 ;
  13910.  
  13911. **** @INTERC
  13912.  
  13913. DEBPROC @INTERC CH_OLD2*CHPOINT CH_NEW2*CHPOINT TOL2*FLOTTANT TAB1*TABLE ;
  13914.  
  13915. *MESS '---------------------------------> calling @INTERC';
  13916.  
  13917. S_OMBRE4 = CH_OLD2 EXTR MAIL ;
  13918. dex4 = nomc scal (exco x (CH_NEW2 - CH_OLD2));
  13919. dey4 = nomc scal (exco y (CH_NEW2 - CH_OLD2));
  13920. dez4 = nomc scal (exco z (CH_NEW2 - CH_OLD2));
  13921.  
  13922. xinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
  13923. yinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
  13924. zinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
  13925.  
  13926. *
  13927. * +++++++++++++++++++++++++++++++++++
  13928. * RECHERCHE DES INTERCECTIONS
  13929. * +++++++++++++++++++++++++++++++++++
  13930. *
  13931. * METHODE CHOISIE: on boucle sur les facettes et on travaille sur les
  13932. * champs par points des points remontes. Cette methode est adaptee
  13933. * a un maillage ombrant reduit et a un maillage ombre volumineux...
  13934. *
  13935.  
  13936. * --- CHAMP CONTENANT N POUR LES NEOUDS DE OMBRE INTERSECTES N FOIS
  13937. *CHINTER2 = manu chpo S_OMBRE4 1 scal 0. 'NATURE' 'DISCRET' ;
  13938. CHINTER2 = manu chpo S_OMBRE4 1 scal 0. ;
  13939.  
  13940. S_OMBRA3 = extr tab1.<chamx1 mail ;
  13941. nel1 = nbel S_OMBRA3 ;
  13942.  
  13943. repe boucel1 nel1;
  13944.  
  13945. * mess 'facette numero' &boucel1 ;
  13946.  
  13947. el1 = S_OMBRA3 elem &boucel1 ;
  13948.  
  13949. * on extrait les coordonnees du point A de la facette
  13950. xa1 = extr tab1.<chamx1 scal 1 &boucel1 1 ;
  13951. ya1 = extr tab1.<chamy1 scal 1 &boucel1 1 ;
  13952. za1 = extr tab1.<chamz1 scal 1 &boucel1 1 ;
  13953. *
  13954. xb1 = extr tab1.<chamx2 scal 1 &boucel1 1 ;
  13955. yb1 = extr tab1.<chamy2 scal 1 &boucel1 1 ;
  13956. zb1 = extr tab1.<chamz2 scal 1 &boucel1 1 ;
  13957. *
  13958. xc1 = extr tab1.<chamx3 scal 1 &boucel1 1 ;
  13959. yc1 = extr tab1.<chamy3 scal 1 &boucel1 1 ;
  13960. zc1 = extr tab1.<chamz3 scal 1 &boucel1 1 ;
  13961.  
  13962. * on calcule les vecteurs APn et APn+1
  13963. apnx1 = (exco X CH_OLD2) - xa1 ;
  13964. apny1 = (exco Y CH_OLD2) - ya1 ;
  13965. apnz1 = (exco Z CH_OLD2) - za1 ;
  13966.  
  13967. apnp1x1 = (exco x CH_NEW2) - xa1 ;
  13968. apnp1y1 = (exco y CH_NEW2) - ya1 ;
  13969. apnp1z1 = (exco z CH_NEW2) - za1 ;
  13970.  
  13971. * on extrait les cosinus directeurs de la normale de la facette
  13972. nfx1 = extr tab1.<cosx scal 1 &boucel1 1;
  13973. nfy1 = extr tab1.<cosy scal 1 &boucel1 1;
  13974. nfz1 = extr tab1.<cosz scal 1 &boucel1 1;
  13975.  
  13976. * on effectue les produits scalaires.
  13977. ps1 = (apnx1 * nfx1) + (apny1 * nfy1) + (apnz1 * nfz1);
  13978. ps2 = (apnp1x1 * nfx1) + (apnp1y1 * nfy1) + (apnp1z1 * nfz1);
  13979. pp1 = ps1*ps2 ;
  13980.  
  13981. * la je suis dans la facette i et je determine quels sont les segments
  13982. * PnPn+1 qui traversent le plan de la facette.
  13983. * si le produit scalaire est nul, c'est que un des noeuds p1 ou p2 est
  13984. * dans le plan de la facette
  13985.  
  13986. * segments de part et d'autre de la facette
  13987. mail3 = pp1 poin infe (-1.*tol2*tol2) ;
  13988. * si Pn+1 appartient au maillage ombrant
  13989. mail6 = ps2 poin egale 0. ;
  13990. mail7 = mail3 et mail6 ;
  13991. n_mail7 = nbno mail7 ;
  13992. si (ega (n_mail7) 0) ;
  13993. iter boucel1;
  13994. finsi ;
  13995.  
  13996. * mail3 est le maillage des noeuds de mail2 pour lesquels le segment incremente
  13997. * le long de la ligne de champ intersecte (largement)le plan de la facette
  13998. * en cours... c'est a dire qu'on inclut les cas ou Pn ou Pn+1 sont dans le plan
  13999. * de la facette
  14000. * on va calculer le point d'intersection que pour ces points la.
  14001.  
  14002. dex2 = redu dex4 (mail7) ;
  14003. dey2 = redu dey4 (mail7) ;
  14004. dez2 = redu dez4 (mail7) ;
  14005.  
  14006. chr1 = redu CH_OLD2 (mail7) ;
  14007. chr2 = redu CH_NEW2 (mail7) ;
  14008.  
  14009. chrx1 = nomc scal (exco chr1 x) ;
  14010. chry1 = nomc scal (exco chr1 y) ;
  14011. chrz1 = nomc scal (exco chr1 z) ;
  14012.  
  14013.  
  14014. ad1 = (dex2 * nfx1) + (dey2 * nfy1) + (dez2 * nfz1) ;
  14015. * mess 'ad1' ;(list ad1) ;
  14016. * on exclu avec une tolerence, les segments qui sont paralleles a la facette
  14017. * => on considere qu'il n'y a pas d'intersection pour ces noeuds la
  14018. mail4 = (abs ad1) poin superieur TOL2 ;
  14019. n_mail4 = nbno mail4 ;
  14020. * mess 'nb de segments non // a la facette' n_mail4 ;
  14021. si (ega n_mail4 0) ;
  14022. iter boucel1;
  14023. finsi ;
  14024. ad2 = redu ad1 mail4 ;
  14025. dex3 = redu dex2 mail4 ;
  14026. dey3 = redu dey2 mail4 ;
  14027. dez3 = redu dez2 mail4 ;
  14028. chrx2 = redu chrx1 mail4 ;
  14029. chry2 = redu chry1 mail4 ;
  14030. chrz2 = redu chrz1 mail4 ;
  14031.  
  14032. bx1 = (xa1*dex3*nfx1) - ((((chry2-ya1)*dex3)-(chrx2*dey3))*nfy1) - ((((chrz2-za1)*dex3)-(chrx2*dez3))*nfz1);
  14033.  
  14034. by1 = (ya1*dey3*nfy1) - ((((chrz2-za1)*dey3)-(chry2*dez3))*nfz1) - ((((chrx2-xa1)*dey3)-(chry2*dex3))*nfx1);
  14035.  
  14036. bz1 = (za1*dez2*nfz1) - ((((chrx2-xa1)*dez3)-(chrz2*dex3))*nfx1) - ((((chry2-ya1)*dez3)-(chrz2*dey3))*nfy1);
  14037. xm1 = bx1 / ad2 ;
  14038. ym1 = by1 / ad2 ;
  14039. zm1 = bz1 / ad2 ;
  14040.  
  14041. * xm1, ym1 et zm1 sont des champs par points definis sur mail7,
  14042. * maillage des points de mail2 (ombre) dont les segments incrementes
  14043. * du pas n interseptent la facette en cours. Ces champs par points
  14044. * contiennent les coordonnees des intersections entre le segment
  14045. * du point considere avec le plan de la facette courante.
  14046.  
  14047.  
  14048. * maintenant, on va chercher les coordonnes barycentriques de M dans
  14049. * le repere baryentrique forme par les trois sommets de la facette
  14050. * en cours A, B, C.
  14051.  
  14052. dxa1 = xm1 - xa1 ;
  14053. dxb1 = xm1 - xb1 ;
  14054. dxc1 = xm1 - xc1 ;
  14055. dya1 = ym1 - ya1 ;
  14056. dyb1 = ym1 - yb1 ;
  14057. dyc1 = ym1 - yc1 ;
  14058. dza1 = zm1 - za1 ;
  14059. dzb1 = zm1 - zb1 ;
  14060. dzc1 = zm1 - zc1 ;
  14061.  
  14062. * denominateur suivant les 3 axes :
  14063. Dz = (dyc1*dxb1)-(dxc1*dyb1)+(dxa1*dyb1)-(dxa1*dyc1)-(dya1*dxb1) +(dya1*dxc1) ;
  14064. Dy = (dzc1*dxb1)-(dxc1*dzb1)+(dxa1*dzb1)-(dxa1*dzc1)-(dza1*dxb1) +(dza1*dxc1) ;
  14065. Dx = (dyc1*dzb1)-(dzc1*dyb1)+(dza1*dyb1)-(dza1*dyc1)-(dya1*dzb1) +(dya1*dzc1) ;
  14066. *
  14067. *
  14068. si ((maxi (abs Dz)) > tol2) ;
  14069. D1 = Dz ;
  14070. a1 = (dyc1*dxb1) - (dxc1*dyb1) ;
  14071. b1 = (dya1*dxc1) - (dxa1*dyc1) ;
  14072. c1 = (dyb1*dxa1) - (dxb1*dya1) ;
  14073. sinon ;
  14074. si ((maxi (abs Dy)) > tol2) ;
  14075. D1 = Dy ;
  14076. a1 = (dzc1*dxb1) - (dxc1*dzb1) ;
  14077. b1 = (dza1*dxc1) - (dxa1*dzc1) ;
  14078. c1 = (dzb1*dxa1) - (dxb1*dza1) ;
  14079. sinon ;
  14080. D1 = Dx ;
  14081. a1 = (dyc1*dzb1) - (dzc1*dyb1) ;
  14082. b1 = (dya1*dzc1) - (dza1*dyc1) ;
  14083. c1 = (dyb1*dza1) - (dzb1*dya1) ;
  14084. finsi ;
  14085. finsi ;
  14086.  
  14087. * calcul de alpha1
  14088. alpha1 = a1 / D1 ;
  14089.  
  14090. * calcul de beta1
  14091. beta1 = b1 / D1 ;
  14092. *
  14093. * calcul de gamma1
  14094. gamma1 = c1 / D1 ;
  14095.  
  14096.  
  14097. * si alpha et beta et gama sont tous superieurs ou egaux a 0,
  14098. * le point d'intersection est dans la facette et il y a intersection
  14099.  
  14100. * CHPO CONTENANT 1 POUR LES NOEUDS INTERSECTES PAR LA FACETTE COURANTE
  14101. CHINTER1 = (alpha1 masque egsupe 0.) * (beta1 masque egsupe 0.) * (gamma1 masque egsupe 0.) ;
  14102.  
  14103. * PTPRIS1 = CHINTER1 POIN DIFF 0. ;
  14104. * mess 'nb noeuds intersectes (pour la facette) =' (nbno PTPRIS1);
  14105.  
  14106. * maillage de noeuds n'ayant pas deja ete intersectes
  14107. chinter3 = CHINTER1 - CHINTER2 ;
  14108. mail5 = (abs (chinter3 - 1.)) poin inferieur TOL2 ;
  14109.  
  14110. * CHPO CONTENANT N POUR LES NOEUDS INTERSECTES PAR N FACETTES
  14111. CHINTER2 = CHINTER1 + CHINTER2 ;
  14112.  
  14113. * PTPRIS2 = CHINTER2 POIN DIFF 0. ;
  14114. * mess 'nb noeuds intersectes (pour ttes les facettes) =' (nbno PTPRIS2);
  14115.  
  14116. * on calcule des CHPO reduits aux noeuds intersectes
  14117. xm1_r = redu xm1 mail5 ;
  14118. ym1_r = redu ym1 mail5 ;
  14119. zm1_r = redu zm1 mail5 ;
  14120. xm1_r = chan 'ATTRIBUT' xm1_r nature discret ;
  14121. ym1_r = chan 'ATTRIBUT' ym1_r nature discret ;
  14122. zm1_r = chan 'ATTRIBUT' zm1_r nature discret ;
  14123.  
  14124. * concatenation des coordonnees des intersections
  14125. xinter1 = xinter1 et xm1_r ;
  14126. yinter1 = yinter1 et ym1_r ;
  14127. zinter1 = zinter1 et zm1_r ;
  14128.  
  14129. mena ;
  14130.  
  14131. fin boucel1 ;
  14132. * -- Fin de la grande boucle sur les facettes intersectantes --
  14133.  
  14134. * maillage contenant les noeuds intersectes
  14135. minter1 = chinter2 poin different 0. ;
  14136.  
  14137. *** RM diagnostic
  14138. *mess 'nbno minter1' (nbno minter1) ;
  14139. *mess 'xinter1' ;
  14140. *@listmm xinter1 ;
  14141. *mess 'yinter1' ;
  14142. *@listmm yinter1 ;
  14143. *mess 'zinter1' ;
  14144. *@listmm zinter1 ;
  14145. *** RM fin diagnostic
  14146.  
  14147. * difference symetrique (ou l'on impose PAS)
  14148. nointer1 = diff minter1 S_OMBRE4 ;
  14149.  
  14150. * calcul du pas sur tout le maillage s_ombre4
  14151. chpas0 = ((dex4 * dex4) + (dey4 * dey4) + (dez4 * dez4)) ** 0.5 ;
  14152.  
  14153. * distances entre points initiaux et M (uniquement sur noeuds inters)
  14154.  
  14155. si ((nbno minter1) > 0) ;
  14156. xinter1r = redu xinter1 minter1 ;
  14157. yinter1r = redu yinter1 minter1 ;
  14158. zinter1r = redu zinter1 minter1 ;
  14159.  
  14160. CH_OLD2r = redu CH_OLD2 minter1 ;
  14161. xp1 = exco X CH_OLD2r ;
  14162. yp1 = exco Y CH_OLD2r ;
  14163. zp1 = exco Z CH_OLD2r ;
  14164.  
  14165. dxmp1 = xp1 - xinter1r ;
  14166. dymp1 = yp1 - yinter1r ;
  14167. dzmp1 = zp1 - zinter1r ;
  14168.  
  14169. chdmp1 = ((dxmp1 * dxmp1) + (dymp1 * dymp1) + (dzmp1 * dzmp1)) ** 0.5 ;
  14170. chdmp1 = chan 'ATTRIBUT' chdmp1 nature diffus ;
  14171.  
  14172. si ((nbno nointer1) > 0) ;
  14173. * on peut avoit tout intersecte auquel cas on n a pas a mettre le
  14174. * pas pour les autres
  14175. chdist1 = redu chpas0 nointer1 ;
  14176. chdist1 = chan 'ATTRIBUT' chdist1 nature diffus ;
  14177. chdist8 = chdist1 et chdmp1 ;
  14178. sinon ;
  14179. chdist8 = chdmp1 ;
  14180. finsi ;
  14181. sinon ;
  14182. chdist8 = chpas0 ;
  14183. finsi ;
  14184.  
  14185. chdist9 = chan 'ATTRIBUT' chdist8 nature discret ;
  14186.  
  14187. *MESS '---------------------------------> exiting @INTERC';
  14188.  
  14189. FINPROC chdist9 minter1 ;
  14190.  
  14191. debproc inters mail1*maillage p1*maillage p2*maillage ;
  14192.  
  14193. finproc ;
  14194. **** @INTSEC
  14195.  
  14196. DEBPROC @INTSEC CH_OLD2*CHPOINT CH_NEW2*CHPOINT TOL2*FLOTTANT TAB1*TABLE ;
  14197. *
  14198. **********************************************
  14199. * Procedure (inspiree de @INTERC) calculant *
  14200. * l'intersection des lignes de champ avec un *
  14201. * objet constitue de facettes triangulaires *
  14202. * par une methode analytique exacte. *
  14203. * Alain MOAL (Fevrier 2001) *
  14204. **********************************************
  14205. *
  14206. *MESS '---------------------------------> calling @INTSEC';
  14207.  
  14208. S_OMBRE4 = CH_OLD2 EXTR MAIL ;
  14209. dex4 = nomc scal (exco x (CH_NEW2 - CH_OLD2));
  14210. dey4 = nomc scal (exco y (CH_NEW2 - CH_OLD2));
  14211. dez4 = nomc scal (exco z (CH_NEW2 - CH_OLD2));
  14212.  
  14213. xinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
  14214. yinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
  14215. zinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
  14216. finter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
  14217. *
  14218. * +++++++++++++++++++++++++++++++++++
  14219. * RECHERCHE DES INTERCECTIONS
  14220. * +++++++++++++++++++++++++++++++++++
  14221. *
  14222. * METHODE CHOISIE: on boucle sur les facettes et on travaille sur les
  14223. * champs par points des points remontes. Cette methode est adaptee
  14224. * a un maillage ombrant reduit et a un maillage ombre volumineux...
  14225. *
  14226. * --- CHAMP CONTENANT N POUR LES NOEUDS DE OMBRE INTERSECTES N FOIS
  14227. *CHINTER2 = manu chpo S_OMBRE4 1 scal 0. 'NATURE' 'DISCRET' ;
  14228. CHINTER2 = manu chpo S_OMBRE4 1 scal 0. ;
  14229.  
  14230. S_OMBRA3 = extr tab1.<chelx1 mail ;
  14231. nel1 = nbel S_OMBRA3 ;
  14232.  
  14233. repe boucel1 nel1;
  14234.  
  14235. * mess 'facette numero' &boucel1 ;
  14236.  
  14237. el1 = S_OMBRA3 elem &boucel1 ;
  14238.  
  14239. * on extrait les coordonnees du point A de la facette
  14240. xa1 = extr tab1.<chelx1 scal 1 &boucel1 1 ;
  14241. ya1 = extr tab1.<chely1 scal 1 &boucel1 1 ;
  14242. za1 = extr tab1.<chelz1 scal 1 &boucel1 1 ;
  14243. *
  14244. xb1 = extr tab1.<chelx2 scal 1 &boucel1 1 ;
  14245. yb1 = extr tab1.<chely2 scal 1 &boucel1 1 ;
  14246. zb1 = extr tab1.<chelz2 scal 1 &boucel1 1 ;
  14247. *
  14248. xc1 = extr tab1.<chelx3 scal 1 &boucel1 1 ;
  14249. yc1 = extr tab1.<chely3 scal 1 &boucel1 1 ;
  14250. zc1 = extr tab1.<chelz3 scal 1 &boucel1 1 ;
  14251.  
  14252. * on extrait le flux normalise en chaque point de la facette
  14253. f1 = extr tab1.<chamf1 scal 1 &boucel1 1 ;
  14254. f2 = extr tab1.<chamf2 scal 1 &boucel1 1 ;
  14255. f3 = extr tab1.<chamf3 scal 1 &boucel1 1 ;
  14256.  
  14257. * on calcule les vecteurs APn et APn+1
  14258. apnx1 = (exco X CH_OLD2) - xa1 ;
  14259. apny1 = (exco Y CH_OLD2) - ya1 ;
  14260. apnz1 = (exco Z CH_OLD2) - za1 ;
  14261.  
  14262. apnp1x1 = (exco x CH_NEW2) - xa1 ;
  14263. apnp1y1 = (exco y CH_NEW2) - ya1 ;
  14264. apnp1z1 = (exco z CH_NEW2) - za1 ;
  14265.  
  14266. * on extrait les cosinus directeurs de la normale de la facette
  14267. nfx1 = extr tab1.<cosinusx scal 1 &boucel1 1;
  14268. nfy1 = extr tab1.<cosinusy scal 1 &boucel1 1;
  14269. nfz1 = extr tab1.<cosinusz scal 1 &boucel1 1;
  14270.  
  14271. * on effectue les produits scalaires.
  14272. ps1 = (apnx1 * nfx1) + (apny1 * nfy1) + (apnz1 * nfz1);
  14273. ps2 = (apnp1x1 * nfx1) + (apnp1y1 * nfy1) + (apnp1z1 * nfz1);
  14274. pp1 = ps1*ps2 ;
  14275.  
  14276. * la je suis dans la facette i et je determine quels sont les segments
  14277. * PnPn+1 qui traversent le plan de la facette.
  14278. * si le produit scalaire est nul, c'est que un des noeuds p1 ou p2 est
  14279. * dans le plan de la facette
  14280.  
  14281. * segments de part et d'autre de la facette
  14282. mail3 = pp1 poin infe (-1.*tol2*tol2) ;
  14283. * si Pn+1 appartient au maillage ombrant
  14284. mail6 = ps2 poin egale 0. ;
  14285. mail7 = mail3 et mail6 ;
  14286. n_mail7 = nbno mail7 ;
  14287. si (ega (n_mail7) 0) ;
  14288. iter boucel1;
  14289. finsi ;
  14290.  
  14291. * mail3 est le maillage des noeuds de mail2 pour lesquels le segment incremente
  14292. * le long de la ligne de champ intersecte (largement)le plan de la facette
  14293. * en cours... c'est a dire qu'on inclut les cas ou Pn ou Pn+1 sont dans le plan
  14294. * de la facette
  14295. * on va calculer le point d'intersection que pour ces points la.
  14296.  
  14297. dex2 = redu dex4 (mail7) ;
  14298. dey2 = redu dey4 (mail7) ;
  14299. dez2 = redu dez4 (mail7) ;
  14300.  
  14301. chr1 = redu CH_OLD2 (mail7) ;
  14302. chr2 = redu CH_NEW2 (mail7) ;
  14303.  
  14304. chrx1 = nomc scal (exco chr1 x) ;
  14305. chry1 = nomc scal (exco chr1 y) ;
  14306. chrz1 = nomc scal (exco chr1 z) ;
  14307.  
  14308.  
  14309. ad1 = (dex2 * nfx1) + (dey2 * nfy1) + (dez2 * nfz1) ;
  14310. * mess 'ad1' ;(list ad1) ;
  14311. * on exclu avec une tolerence, les segments qui sont paralleles a la facette
  14312. * => on considere qu'il n'y a pas d'intersection pour ces noeuds la
  14313. mail4 = (abs ad1) poin superieur TOL2 ;
  14314. n_mail4 = nbno mail4 ;
  14315. * mess 'nb de segments non // a la facette' n_mail4 ;
  14316. si (ega n_mail4 0) ;
  14317. iter boucel1;
  14318. finsi ;
  14319. ad2 = redu ad1 mail4 ;
  14320. dex3 = redu dex2 mail4 ;
  14321. dey3 = redu dey2 mail4 ;
  14322. dez3 = redu dez2 mail4 ;
  14323. chrx2 = redu chrx1 mail4 ;
  14324. chry2 = redu chry1 mail4 ;
  14325. chrz2 = redu chrz1 mail4 ;
  14326.  
  14327. bx1 = (xa1*dex3*nfx1) - ((((chry2-ya1)*dex3)-(chrx2*dey3))*nfy1) - ((((chrz2-za1)*dex3)-(chrx2*dez3))*nfz1);
  14328.  
  14329. by1 = (ya1*dey3*nfy1) - ((((chrz2-za1)*dey3)-(chry2*dez3))*nfz1) - ((((chrx2-xa1)*dey3)-(chry2*dex3))*nfx1);
  14330.  
  14331. bz1 = (za1*dez2*nfz1) - ((((chrx2-xa1)*dez3)-(chrz2*dex3))*nfx1) - ((((chry2-ya1)*dez3)-(chrz2*dey3))*nfy1);
  14332. xm1 = bx1 / ad2 ;
  14333. ym1 = by1 / ad2 ;
  14334. zm1 = bz1 / ad2 ;
  14335.  
  14336. * xm1, ym1 et zm1 sont des champs par points definis sur mail7,
  14337. * maillage des points de mail2 (ombre) dont les segments incrementes
  14338. * du pas n interseptent la facette en cours. Ces champs par points
  14339. * contiennent les coordonnees des intersections entre le segment
  14340. * du point considere avec le plan de la facette courante.
  14341.  
  14342.  
  14343. * maintenant, on va chercher les coordonnes barycentriques de M dans
  14344. * le repere baryentrique forme par les trois sommets de la facette
  14345. * en cours A, B, C.
  14346.  
  14347. dxa1 = xm1 - xa1 ;
  14348. dxb1 = xm1 - xb1 ;
  14349. dxc1 = xm1 - xc1 ;
  14350. dya1 = ym1 - ya1 ;
  14351. dyb1 = ym1 - yb1 ;
  14352. dyc1 = ym1 - yc1 ;
  14353. dza1 = zm1 - za1 ;
  14354. dzb1 = zm1 - zb1 ;
  14355. dzc1 = zm1 - zc1 ;
  14356.  
  14357. * denominateur suivant les 3 axes :
  14358. Dz = (dyc1*dxb1)-(dxc1*dyb1)+(dxa1*dyb1)-(dxa1*dyc1)-(dya1*dxb1) +(dya1*dxc1) ;
  14359. Dy = (dzc1*dxb1)-(dxc1*dzb1)+(dxa1*dzb1)-(dxa1*dzc1)-(dza1*dxb1) +(dza1*dxc1) ;
  14360. Dx = (dyc1*dzb1)-(dzc1*dyb1)+(dza1*dyb1)-(dza1*dyc1)-(dya1*dzb1) +(dya1*dzc1) ;
  14361. *
  14362. *
  14363. si ((maxi (abs Dz)) > tol2) ;
  14364. D1 = Dz ;
  14365. a1 = (dyc1*dxb1) - (dxc1*dyb1) ;
  14366. b1 = (dya1*dxc1) - (dxa1*dyc1) ;
  14367. c1 = (dyb1*dxa1) - (dxb1*dya1) ;
  14368. sinon ;
  14369. si ((maxi (abs Dy)) > tol2) ;
  14370. D1 = Dy ;
  14371. a1 = (dzc1*dxb1) - (dxc1*dzb1) ;
  14372. b1 = (dza1*dxc1) - (dxa1*dzc1) ;
  14373. c1 = (dzb1*dxa1) - (dxb1*dza1) ;
  14374. sinon ;
  14375. D1 = Dx ;
  14376. a1 = (dyc1*dzb1) - (dzc1*dyb1) ;
  14377. b1 = (dya1*dzc1) - (dza1*dyc1) ;
  14378. c1 = (dyb1*dza1) - (dzb1*dya1) ;
  14379. finsi ;
  14380. finsi ;
  14381.  
  14382. * calcul de alpha1
  14383. alpha1 = a1 / D1 ;
  14384.  
  14385. * calcul de beta1
  14386. beta1 = b1 / D1 ;
  14387. *
  14388. * calcul de gamma1
  14389. gamma1 = c1 / D1 ;
  14390. *
  14391. * flux normalise au point trouve (sur un triangle a 3 noeuds
  14392. * les fonctions de forme sont les coordonnees barycentriques)
  14393. fm0 = (alpha1 * f1) + (beta1 * f2) + (gamma1 * f3) ;
  14394.  
  14395. * si alpha et beta et gama sont tous superieurs ou egaux a 0,
  14396. * le point d'intersection est dans la facette et il y a intersection
  14397.  
  14398. * CHPO CONTENANT 1 POUR LES NOEUDS INTERSECTES PAR LA FACETTE COURANTE
  14399. CHINTER1 = (alpha1 masque egsupe 0.) * (beta1 masque egsupe 0.) * (gamma1 masque egsupe 0.) ;
  14400.  
  14401. * PTPRIS1 = CHINTER1 POIN DIFF 0. ;
  14402. * mess 'nb noeuds intersectes (pour la facette) =' (nbno PTPRIS1);
  14403.  
  14404. * maillage de noeuds n'ayant pas deja ete intersectes
  14405. chinter3 = CHINTER1 - CHINTER2 ;
  14406. mail5 = (abs (chinter3 - 1.)) poin inferieur TOL2 ;
  14407.  
  14408. * CHPO CONTENANT N POUR LES NOEUDS INTERSECTES PAR N FACETTES
  14409. CHINTER2 = CHINTER1 + CHINTER2 ;
  14410.  
  14411. * PTPRIS2 = CHINTER2 POIN DIFF 0. ;
  14412. * mess 'nb noeuds intersectes (pour ttes les facettes) =' (nbno PTPRIS2);
  14413.  
  14414. * on calcule des CHPO reduits aux noeuds intersectes
  14415. xm1_r = redu xm1 mail5 ;
  14416. ym1_r = redu ym1 mail5 ;
  14417. zm1_r = redu zm1 mail5 ;
  14418. xm1_r = chan 'ATTRIBUT' xm1_r nature discret ;
  14419. ym1_r = chan 'ATTRIBUT' ym1_r nature discret ;
  14420. zm1_r = chan 'ATTRIBUT' zm1_r nature discret ;
  14421. fm0_r = redu fm0 mail5 ;
  14422. fm0_r = chan 'ATTRIBUT' fm0_r nature discret ;
  14423.  
  14424.  
  14425. * concatenation des coordonnees des intersections
  14426. xinter1 = xinter1 et xm1_r ;
  14427. yinter1 = yinter1 et ym1_r ;
  14428. zinter1 = zinter1 et zm1_r ;
  14429.  
  14430. * concatenation du flux normalise aux points d'intersection
  14431. finter1 = finter1 et fm0_r ;
  14432.  
  14433.  
  14434. fin boucel1 ;
  14435. * -- Fin de la grande boucle sur les facettes intersectantes --
  14436.  
  14437. * maillage contenant les noeuds intersectes
  14438. minter1 = chinter2 poin different 0. ;
  14439.  
  14440. * difference symetrique (ou l'on impose PAS)
  14441. nointer1 = diff minter1 S_OMBRE4 ;
  14442.  
  14443. * calcul du pas sur tout le maillage s_ombre4
  14444. chpas0 = ((dex4 * dex4) + (dey4 * dey4) + (dez4 * dez4)) ** 0.5 ;
  14445.  
  14446. * flux normalise initialise sur le maillage s_ombre4
  14447. chfn0 = manu chpo S_OMBRE4 1 scal 0. ;
  14448.  
  14449. * distances entre points initiaux et M (uniquement sur noeuds inters)
  14450.  
  14451. si ((nbno minter1) > 0) ;
  14452. xinter1r = redu xinter1 minter1 ;
  14453. yinter1r = redu yinter1 minter1 ;
  14454. zinter1r = redu zinter1 minter1 ;
  14455.  
  14456. finter1r = redu finter1 minter1 ;
  14457. finter1r = chan 'ATTRIBUT' finter1r nature diffus ;
  14458.  
  14459. CH_OLD2r = redu CH_OLD2 minter1 ;
  14460. xp1 = exco X CH_OLD2r ;
  14461. yp1 = exco Y CH_OLD2r ;
  14462. zp1 = exco Z CH_OLD2r ;
  14463.  
  14464. dxmp1 = xp1 - xinter1r ;
  14465. dymp1 = yp1 - yinter1r ;
  14466. dzmp1 = zp1 - zinter1r ;
  14467.  
  14468. chdmp1 = ((dxmp1 * dxmp1) + (dymp1 * dymp1) + (dzmp1 * dzmp1)) ** 0.5 ;
  14469. chdmp1 = chan 'ATTRIBUT' chdmp1 nature diffus ;
  14470.  
  14471. * champ de deplacement des points interceptes
  14472. dxmp1 = (NOMC UX dxmp1 NATURE DIFFUS) * (-1.) ;
  14473. dymp1 = (NOMC UY dymp1 NATURE DIFFUS) * (-1.) ;
  14474. dzmp1 = (NOMC UZ dzmp1 NATURE DIFFUS) * (-1.) ;
  14475. depmp1 = dxmp1 et dymp1 et dzmp1 ;
  14476.  
  14477. si ((nbno nointer1) > 0) ;
  14478. * on peut avoit tout intersecte auquel cas on n a pas a mettre le
  14479. * pas pour les autres
  14480. chdist1 = redu chpas0 nointer1 ;
  14481. chdist1 = chan 'ATTRIBUT' chdist1 nature diffus ;
  14482. chdist8 = chdist1 et chdmp1 ;
  14483. chfn1 = redu chfn0 nointer1 ;
  14484. chfn1 = chan 'ATTRIBUT' chfn1 nature diffus ;
  14485. chfn8 = chfn1 et finter1r ;
  14486. sinon ;
  14487. chdist8 = chdmp1 ;
  14488. chfn8 = finter1r ;
  14489. finsi ;
  14490. sinon ;
  14491. chdist8 = chpas0 ;
  14492. chfn8 = chfn0 ;
  14493. dxmp1 = (NOMC UX ((exco X CH_OLD2) * 0.) NATURE DIFFUS) ;
  14494. dymp1 = (NOMC UY ((exco Y CH_OLD2) * 0.) NATURE DIFFUS) ;
  14495. dzmp1 = (NOMC UZ ((exco Z CH_OLD2) * 0.) NATURE DIFFUS) ;
  14496. depmp1 = dxmp1 et dymp1 et dzmp1 ;
  14497. finsi ;
  14498.  
  14499. chdist9 = chan 'ATTRIBUT' chdist8 nature discret ;
  14500. chfn9 = chan 'ATTRIBUT' chfn8 nature discret ;
  14501.  
  14502. *MESS '---------------------------------> exiting @INTSEC';
  14503.  
  14504. FINPROC chdist9 minter1 chfn9 depmp1;
  14505.  
  14506. **** IPOE
  14507. DEBPROC IPOE OBJ_11/FLOTTANT OBJ_12/LISTREEL OBJ_13/CHPOINT EVO_1*EVOLUTION MO_1/MOT ;
  14508. MESS '>>>>IPOE 30/4/96 Please call now @IPOE ';
  14509. 'FINPROC' ;
  14510. **** @IPOE
  14511. DEBPROC @IPOE OBJ_11/FLOTTANT OBJ_12/LISTREEL OBJ_13/CHPOINT EVO_1*EVOLUTION MO_1/MOT ;
  14512. *********************************************************
  14513. ****** PROCEDURE @IPOE ******
  14514. *********************************************************
  14515. * INTERPOLATION EN UTILISANT UNE EVOLUTION
  14516. *--------------------------------------------------------
  14517. *23456789012345678901234567890123456789012345678901234567890123456789012
  14518. * 1 2 3 4 5 6 7
  14519. LRE_1 = EXTR EVO_1 'ABSC' 1 ;
  14520. LRE_2 = EXTR EVO_1 'ORDO' 1 ;
  14521. SI ( NON (EXISTE MO_1)) ;
  14522. MO_2 = MOT 'SANS' ;
  14523. SINON ;
  14524. MO_2 = MO_1 ;
  14525. FINSI ;
  14526. SI (( EGA MO_2 'LINE' ) OU ( EGA MO_2 'FIXE' )) ;
  14527. SI ( EXISTE OBJ_11 ) ;
  14528. OBJ_2 = @ITPLT LRE_1 LRE_2 MO_2 OBJ_11 ;
  14529. FINSI ;
  14530. SI ( EXISTE OBJ_12 ) ;
  14531. OBJ_2 = @ITPLT LRE_1 LRE_2 MO_2 OBJ_12 ;
  14532. FINSI ;
  14533. SI ( EXISTE OBJ_13 ) ;
  14534. OBJ_2 = @ITPLT LRE_1 LRE_2 MO_2 OBJ_13 ;
  14535. FINSI ;
  14536. SINON ;
  14537. SI ( EXISTE OBJ_11 ) ;
  14538. OBJ_2 = IPOL OBJ_11 LRE_1 LRE_2 ;
  14539. FINSI ;
  14540. SI ( EXISTE OBJ_12 ) ;
  14541. OBJ_2 = IPOL OBJ_12 LRE_1 LRE_2 ;
  14542. FINSI ;
  14543. SI ( EXISTE OBJ_13 ) ;
  14544. OBJ_2 = IPOL OBJ_13 LRE_1 LRE_2 ;
  14545. FINSI ;
  14546. FINSI ;
  14547. FINPROC OBJ_2 ;
  14548. **** @ITPLT
  14549.  
  14550. DEBPROC @ITPLT LR_1*LISTREEL LR_2*LISTREEL MO_1*MOT OBJ_11/FLOTTANT OBJ_12/LISTREEL OBJ_13/CHPOINT ;
  14551.  
  14552. *23456789012345678901234567890123456789012345678901234567890123456789012
  14553. * 1 2 3 4 5 6 7
  14554.  
  14555. *********************************************************
  14556. ****** PROCEDURE @ITPLT ******
  14557. ********************************************************************
  14558. * INTERPOLATION A PARTIR DE 2 LISTREELS AVEC EXTRAPOLATION POSSIBLE
  14559. *-------------------------------------------------------------------
  14560.  
  14561. SI ( NON (( EGA MO_1 'LINE') OU ( EGA MO_1 'FIXE')) ) ;
  14562. MESS '>>>@ITPLT>>> ON VOULAIT LE MOT LINE OU FIXE' ;
  14563. MESS '>>>@ITPLT>>> ON NE FAIT RIEN' ;
  14564. ERREUR 2 ;
  14565. FINSI ;
  14566. SI ( EXISTE OBJ_11 ) ;
  14567. OBJ_1 = OBJ_11 ;
  14568. VMA_1 = OBJ_1 ;
  14569. VMI_1 = OBJ_1 ;
  14570. FINSI ;
  14571. SI ( EXISTE OBJ_12 ) ;
  14572. OBJ_1 = OBJ_12 ;
  14573. VMA_1 = MAXI OBJ_1 ;
  14574. VMI_1 = MINI OBJ_1 ;
  14575. FINSI ;
  14576. SI ( EXISTE OBJ_13 ) ;
  14577. OBJ_1 = OBJ_13 ;
  14578. VMA_1 = MAXI OBJ_1 ;
  14579. VMI_1 = MINI OBJ_1 ;
  14580. FINSI ;
  14581.  
  14582. SI (( VMA_1 < ( MAXI LR_1)) ET ( VMI_1 > ( MINI LR_1)) ) ;
  14583. OBJ_2 = IPOL OBJ_1 LR_1 LR_2 ;
  14584. SINON ;
  14585. LRE_1 = LR_1 ;
  14586. LRE_2 = LR_2 ;
  14587. DVAL = ( MAXI ( ABS LR_1 ) ) / 100. ;
  14588. SI ( NON ( VMA_1 < ( MAXI LR_1)) ) ;
  14589. N1 = DIME LR_1 ;
  14590. VX_F = EXTR LR_1 N1 ;
  14591. VX_F1 = EXTR LR_1 ( N1 - 1 ) ;
  14592. VY_F = EXTR LR_2 N1 ;
  14593. VY_F1 = EXTR LR_2 ( N1 - 1 ) ;
  14594. VX_1 = VMA_1 + DVAL ;
  14595. SI (EGA MO_1 'LINE' ) ;
  14596. VY_1 = VY_F + ((VY_F - VY_F1) * (VX_1 - VX_F)/(VX_F - VX_F1)) ;
  14597. SINON ;
  14598. VY_1 = VY_F ;
  14599. FINSI ;
  14600. LRE_1 = LRE_1 ET ( PROG VX_1 ) ;
  14601. LRE_2 = LRE_2 ET ( PROG VY_1 ) ;
  14602. * MESS '>>1 VAL XMAX YMAX XEXT YEXT' VMA_1 VX_F VY_F VX_1 VY_1 ;
  14603. FINSI ;
  14604. SI ( NON ( VMI_1 > ( MINI LR_1)) ) ;
  14605. VX_I = EXTR LR_1 1 ;
  14606. VX_I1 = EXTR LR_1 2 ;
  14607. VY_I = EXTR LR_2 1 ;
  14608. VY_I1 = EXTR LR_2 2 ;
  14609. VX_1 = VMI_1 - DVAL ;
  14610. SI (EGA MO_1 'LINE' ) ;
  14611. VY_1 = VY_I + ((VY_I - VY_I1) * (VX_1 - VX_I)/(VX_I - VX_I1)) ;
  14612. SINON ;
  14613. VY_1 = VY_I ;
  14614. FINSI ;
  14615. LRE_1 = ( PROG VX_1 ) ET LRE_1 ;
  14616. LRE_2 = ( PROG VY_1 ) ET LRE_2 ;
  14617. * MESS '>>>@ITPLT>>> extrapolation VAL XMIN YMIN XEXT YEXT';
  14618. * MESS VMI_1 VX_I VY_I VX_1 VY_1 ;
  14619. FINSI ;
  14620. OBJ_2 = IPOL OBJ_1 LRE_1 LRE_2 ;
  14621. FINSI ;
  14622.  
  14623. FINPROC OBJ_2 ;
  14624. **** @LECTB
  14625.  
  14626. DEBPROC @LECTB TAB1*TABLE ;
  14627. *
  14628. ***********************************************************
  14629. * Procedure de lecture de la carte de champ magnetique *
  14630. * et de dpsi dans un fichier issu de PROTEUS. *
  14631. * Alain MOAL (Fevrier 2001) *
  14632. ***********************************************************
  14633. * Modif : *
  14634. * 08/11/01 (A.MOAL) : lecture et carte de dpsi *
  14635. ***********************************************************
  14636. *
  14637. MESS '---------------------------------> calling @LECTB';
  14638. *
  14639. *--------------- VARIABLES D'ENTREE :
  14640. NOM0 = TAB1.<NOM_FICHIER_B ;
  14641. ANG0 = TAB1.<EXTENSION_TORO ;
  14642. NBE0 = TAB1.<NBELEM_TORO ;
  14643. CT0 = TAB1.<CENTRE_TORE ;
  14644. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  14645. *------------------------------------
  14646. *
  14647. OPTI ACQUERIR NOM0 ;
  14648. *---- lecture du nombre de lignes a lire dans le fichier
  14649. ACQU NBR1*ENTIER NBZ1*ENTIER FLREF1*FLOTTANT FLREF2*FLOTTANT ;
  14650. I = NBR1 * NBZ1 ;
  14651. MESS '@LECTB IS READING 'I' LINES IN FILE 'NOM0 ;
  14652. MESS 'NODES NUMBER (DIRECTION R) : 'NBR1 ;
  14653. MESS 'NODES NUMBER (DIRECTION Z) : 'NBZ1 ;
  14654.  
  14655. I = NBR1 * NBZ1 ;
  14656. *
  14657. ACQU R0*FLOTTANT Z0*FLOTTANT FLUX1*FLOTTANT BR1*FLOTTANT BZ1*FLOTTANT BTOR1*FLOTTANT DPSI1*FLOTTANT;
  14658. *
  14659. *---- creation du premier point support du champ
  14660. *---- tourne de 1 degre pour etre sur d'envelopper
  14661. *---- le domaine d'etude
  14662. P0 = (R0 0. Z0) TOUR (-1.) CT0 CT1 ;
  14663. *
  14664. *---- creation du chpoint s'appuyant sur ce point
  14665. CHPT = MANU CHPO P0 5 'FLUX' FLUX1 'BR' BR1 'BZ' BZ1 'BPHI' BTOR1 'DPSI' DPSI1 'NATURE' DISCRET ;
  14666. *
  14667. *---- boucle sur les points dans la direction toroidale
  14668. J = 0 ;
  14669. REPETER BOUC0 NBE0 ;
  14670. J = J + 1 ;
  14671. P01 = P0 TOUR ((ANG0+2.+1.e-2) * J / NBE0) CT0 CT1 ;
  14672. CHP01 = MANU CHPO P01 5 'FLUX' FLUX1 'BR' BR1 'BZ' BZ1 'BPHI' BTOR1 'DPSI' DPSI1 'NATURE' DISCRET ;
  14673. CHPT = CHPT ET CHP01 ;
  14674. FIN BOUC0 ;
  14675. *
  14676. *---- boucle sur les I-1 autres lignes du tableau
  14677. REPETER BOUC1 (I-1) ;
  14678. ACQU R1*FLOTTANT Z1*FLOTTANT FLUX1*FLOTTANT BR1*FLOTTANT BZ1*FLOTTANT BTOR1*FLOTTANT DPSI1*FLOTTANT;
  14679. P1 =( R1 0. Z1) TOUR (-1.) CT0 CT1 ;
  14680. CHP1 = MANU CHPO P1 5 'FLUX' FLUX1 'BR' BR1 'BZ' BZ1 'BPHI' BTOR1 'DPSI' DPSI1 'NATURE' DISCRET ;
  14681. CHPT = CHPT ET CHP1 ;
  14682. J = 0 ;
  14683. REPETER BOUC2 NBE0 ;
  14684. J = J + 1 ;
  14685. P11 = P1 TOUR ((ANG0+2.+1.e-2) * J / NBE0) CT0 CT1 ;
  14686. CHP11 = MANU CHPO P11 5 'FLUX' FLUX1 'BR' BR1 'BZ' BZ1 'BPHI' BTOR1 'DPSI' DPSI1 'NATURE' DISCRET ;
  14687. CHPT = CHPT ET CHP11 ;
  14688. FIN BOUC2 ;
  14689. FIN BOUC1 ;
  14690.  
  14691. MAIL1 = EXTR CHPT 'MAIL' ;
  14692. VECB = VECT CHPT 0.03 'BR' 'BZ' ROUGE ;
  14693. *
  14694. *---- projection sur un maillage
  14695. P0 = (R0 0. Z0) TOUR (-1.) CT0 CT1 ;
  14696. P1 = (R1 0. Z1) TOUR (-1.) CT0 CT1 ;
  14697. P01 = (R0 0. Z1) TOUR (-1.) CT0 CT1 ;
  14698. P10 = (R1 0. Z0) TOUR (-1.) CT0 CT1 ;
  14699. L1 = P0 D (NBR1-1) P10 ;
  14700. L2 = P10 D (NBZ1-1) P1 ;
  14701. L3 = P1 D (NBR1-1) P01 ;
  14702. L4 = P01 D (NBZ1-1) P0 ;
  14703. S1 = (DALLER L1 L2 L3 L4 PLAN) COUL BLEU ;
  14704. VOL1 = S1 VOLU ROTA NBE0 (ANG0+2.) CT0 CT1 ;
  14705. *
  14706. *---- critere d'elimination inferieur a la taille de maille
  14707. *---- dans le plan (R,Z)
  14708. DIST1 = (MESU L1) / (5. * (NBR1-1)) ;
  14709. DIST2 = (MESU L4) / (5. * (NBZ1-1)) ;
  14710. SI (DIST1 >EG DIST2) ;
  14711. DIST0 = DIST2 ;
  14712. SINON ;
  14713. DIST0 = DIST1 ;
  14714. FINSI ;
  14715. ELIM DIST0 (VOL1 ET MAIL1) ;
  14716. *TITRE ' ';
  14717. *TRAC (VOL1 ET MAIL1) ;
  14718. *
  14719. *---- trace pour verification
  14720. CHPFLU = EXCO 'FLUX' CHPT ;
  14721. TITRE 'MAGNETIC FLUX' ;
  14722. TRAC 30 CHPFLU VOL1 ;
  14723. CHDPSI = EXCO 'DPSI' CHPT ;
  14724. TITRE 'DPSI' ;
  14725. TRAC 30 CHDPSI VOL1 ;
  14726. *
  14727. *--------------- VARIABLES DE SORTIE :
  14728. TAB1.<CARTE_B = CHPT ;
  14729. TAB1.<GRILLE_B = VOL1 ;
  14730. *------------------------------------
  14731. *
  14732. MESS '---------------------------------> exiting @LECTB';
  14733. *
  14734. FINPROC ;
  14735. **** @LECTF
  14736.  
  14737. DEBPROC @LECTF TAB1*TABLE ;
  14738. *
  14739. ***********************************************************
  14740. * Procedure de lecture du flux normalise sur une ligne *
  14741. * dans un fichier issu de PROTEUS. *
  14742. * Alain MOAL (Fevrier 2001) *
  14743. ***********************************************************
  14744. *
  14745. MESS '---------------------------------> calling @LECTF';
  14746. *
  14747. *--------------- VARIABLES D'ENTREE :
  14748. NOM0 = TAB1.<NOM_FICHIER_F ;
  14749. ANG0 = TAB1.<EXTENSION_TORO ;
  14750. NBE0 = TAB1.<NBELEM_TORO ;
  14751. CT0 = TAB1.<CENTRE_TORE ;
  14752. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  14753. *------------------------------------
  14754. *
  14755. OPTI ACQUERIR NOM0 ;
  14756. *---- lecture du nombre de lignes a lire dans le fichier
  14757. ACQU I*ENTIER ;
  14758. MESS '@LECTF IS READING 'I' LINES IN FILE 'NOM0 ;
  14759. *
  14760. *---- ligne de titre
  14761. ACQU MOT1*MOT MOT2*MOT MOT3*MOT MOT4*MOT MOT5*MOT MOT6*MOT MOT7*MOT ;
  14762. *
  14763. ACQU R0*FLOTTANT Z0*FLOTTANT DPSI1*FLOTTANT AEFF10*FLOTTANT DDPSI1*FLOTTANT PLEG1*FLOTTANT Q1*FLOTTANT ;
  14764. *
  14765. *---- creation du premier point support du champ
  14766. *---- tourne de 1 degre pour etre sur d'envelopper
  14767. *---- le domaine d'etude
  14768. P0 = (R0 0. Z0) TOUR (-1.) CT0 CT1 ;
  14769. *
  14770. *---- creation du chpoint s'appuyant sur ce point
  14771. FLUN0 = MANU CHPO P0 1 SCAL Q1 NATURE DISCRET ;
  14772. *
  14773. *---- boucle sur les points dans la direction toroidale
  14774. J = 0 ;
  14775. REPETER BOUC0 NBE0 ;
  14776. J = J + 1 ;
  14777. P01 = P0 TOUR ((ANG0+2.+1.e-2) * J / NBE0) CT0 CT1 ;
  14778. CHP01 = MANU CHPO P01 1 SCAL Q1 NATURE DISCRET ;
  14779. FLUN0 = FLUN0 ET CHP01 ;
  14780. FIN BOUC0 ;
  14781. *
  14782. *---- boucle sur les I-1 autres lignes du tableau
  14783. REPETER BOUC1 (I-1) ;
  14784. ACQU R1*FLOTTANT Z1*FLOTTANT DPSI1*FLOTTANT AEFF10*FLOTTANT DDPSI1*FLOTTANT PLEG1*FLOTTANT Q1*FLOTTANT ;
  14785. P1 =( R1 0. Z1) TOUR (-1.) CT0 CT1 ;
  14786. CHP1 = MANU CHPO P1 1 SCAL Q1 NATURE DISCRET ;
  14787. FLUN0 = FLUN0 ET CHP1 ;
  14788. J = 0 ;
  14789. REPETER BOUC2 NBE0 ;
  14790. J = J + 1 ;
  14791. P11 = P1 TOUR ((ANG0+2.+1.e-2) * J / NBE0) CT0 CT1 ;
  14792. CHP11 = MANU CHPO P11 1 SCAL Q1 NATURE DISCRET ;
  14793. FLUN0 = FLUN0 ET CHP11 ;
  14794. FIN BOUC2 ;
  14795. FIN BOUC1 ;
  14796. MAIL1 = EXTR FLUN0 'MAIL' ;
  14797. *
  14798. *---- projection sur un maillage
  14799. L1 = P0 D (I-1) P1 ;
  14800. S1 = L1 ROTA NBE0 (ANG0+2.) CT0 CT1 ;
  14801. *
  14802. *---- critere d'elimination inferieur a la taille de maille
  14803. *---- dans le plan (R,Z)
  14804. DIST1 = (MESU L1) / (5. * (I-1)) ;
  14805. ELIM DIST1 (S1 ET MAIL1) ;
  14806. *
  14807. *---- trace pour verification
  14808. TITRE 'NORMALISED FLUX' ;
  14809. EVOL1 = EVOL ROUG CHPO (REDU FLUN0 L1) L1 ;
  14810. DESS EVOL1 ;
  14811. TRAC 30 FLUN0 S1 ;
  14812. *
  14813. *--------------- VARIABLES DE SORTIE :
  14814. TAB1.<FLUX_NORMALISE = FLUN0 ;
  14815. TAB1.<MAILLAGE_FN = S1 ;
  14816. *------------------------------------
  14817. *
  14818. MESS '---------------------------------> exiting @LECTF';
  14819. *
  14820. FINPROC ;
  14821. **** @LISTMM
  14822. DEBPROC @LISTMM CHAM1/MCHAML CHP1/CHPOINT;
  14823.  
  14824. SI (EXISTE CHAM1);
  14825. CH1 = CHAM1 ;
  14826. SINON;
  14827. SI (EXISTE CHP1);
  14828. CH1 = CHP1;
  14829. SINON ;
  14830. ERRE 'IL MANQUE LE CHAMPS';
  14831. FINSI ;
  14832. FINSI ;
  14833. MESS ' ';
  14834.  
  14835. DD1 = DIME (EXTR CH1 COMP);
  14836. SI (DD1 > 1 );
  14837. MESS 'BEWARE ! the field has more than one component';
  14838. FINSI ;
  14839.  
  14840. MIN1 = MINI CH1;
  14841. MAX1 = MAXI CH1;
  14842. PRE1 = ' ';
  14843. MES1 = CHAIN PRE1 'mini ' MIN1 ' maxi ' MAX1;
  14844. MESS MES1;
  14845. FINPROC ;
  14846. **** LUMIN
  14847. * @LUMIN LINC2 PENDO1 TAB1 PHIENDO ;
  14848. *>LINC2 = LINC2; >POI1=PENDO1 ;>PHI1=PHIENDO;
  14849. DEBPROC @LUMIN >LINC2*MAILLAGE >POI1/POINT TAB1*TABLE >PHI1/FLOTTANT;
  14850. MESS '>>>>>> DEBUT @LUMIN >>>>>>>PHI=' >PHI1;
  14851. TEMP1 = NOMC SCAL TAB1.TEMPERATURE ;
  14852. *CHX1 = COOR 1 TAB1.LFLUX_EXTE_DESS;
  14853. *EVTEMX = EVOL BLEU CHPO CHX1 SCAL TAB1.LFLUX_EXTE_DESS;
  14854. *DESS EVTEMX ;
  14855. *LIX1 = EXTR EVTEMX 'ORDO' ;
  14856. *LIT1 = EXTR EVTEMI 'ORDO' ;
  14857. *EVTXI = EVOL MANU LIX1 LIT1 ;
  14858. *DESS EVTXI;
  14859. >X3 = REDU TAB1.C_COTETF1 >LINC2 ;
  14860. >Y3 = REDU TAB1.C_SITETF1 >LINC2 ;
  14861. T3 = ATG >Y3 >X3 ;
  14862. TITRE ' angle des normales a la ligne';
  14863. EV3 = EVOL CHPO T3 >LINC2 ;
  14864. DESS EV3;
  14865. >Z3 = 0. ;
  14866. * SINL1 = REDU TAB1.C_SITETF1 >LINC2;
  14867. * CHPX = EXCO SCAL ( 1. * ( COTETF1 ) ) UX ;
  14868. * CHPY = EXCO SCAL ( 1. * ( SITETF1 ) ) UY ;
  14869. * CHPT = (@ET CHPX CHPY );
  14870. * VEC22 = @VECADA CHPT ( 1. * 0.01 ) 'ROUGE' ;
  14871. * TRAC 'CACH' TAB1.NISOV TEMP1 SAIG1 VEC22 (CONT SAIG1);
  14872. SI( EXISTE >POI1) ;
  14873. >X11 >Y1 = COOR >POI1 ;
  14874. >X2 >Y2 = COOR >LINC2;
  14875. XCT1 = COOR 1 TAB1.<CENTRE_TORE ;
  14876. >R1 = >X11 - XCT1 ;
  14877. >R0 = 2.4 ;
  14878. >PHI0 = >PHI1 - 15. ;
  14879. >X1 = >R1 * (COS >PHI1) + XCT1 ;
  14880. >X0 = >R0 * (COS >PHI0) + XCT1 ;
  14881. DX0 = >X2 - >X0 ;
  14882. DZ0 = (>Y2 * 0. ) - (( SIN >PHI0) * >R0 ) ;
  14883. * RHO est la distance entre le point courant et le centre du champ
  14884. RHO = ((DX0 ** 2) + (DZ0 ** 2)) ** 0.5 ;
  14885. * RHO0 est la distance maximale entre un point courant et le centre du champ
  14886. RHO0 = 0.69 ;
  14887. * Lint est la longueur d'integration au niveau du point courant
  14888. Lint =(( RHO * RHO * 0.14 / RHO0/RHO0) + 1.) * 4.77E-3 ;
  14889. TITRE 'Pas d integration avant correction' >PHI1 ;
  14890. EVLint = EVOL ROUG CHPO Lint SCAL TAB1.LFLUX_EXTE_DESS;
  14891. DESS EVLint ;
  14892.  
  14893. * ETEND est l'etendue geometrique normalisee a 1 au centre du champ
  14894. ETEND= RHO * RHO / RHO0 / RHO0 * -0.1 + 1. ;
  14895. TITRE 'etendue geometrique normalisee' >PHI1;
  14896. EVEG = EVOL ROUG CHPO ETEND SCAL TAB1.LFLUX_EXTE_DESS;
  14897. DESS EVEG ;
  14898.  
  14899. DX1 = >X2 - >X1 ;
  14900. DY1 = >Y2 - >Y1 ;
  14901. DZ1 = (>Y2 * 0. ) - (( SIN >PHI1) * ( >X11 - XCT1)) ;
  14902. TITRE ' DZ1 en tout point de la ligne ';
  14903. EV5 = EVOL CHPO DZ1 >LINC2 ;
  14904. * DESS EV5;
  14905. TITRE ' DX1 en tout point de la ligne ';
  14906. EV5 = EVOL CHPO DX1 >LINC2 ;
  14907. * DESS EV5;
  14908. NDX = ((DX1 ** 2) + (DY1 ** 2) + (DZ1 ** 2)) ** 0.5 ;
  14909. DX1 = DX1 / NDX;
  14910. DY1 = DY1 / NDX;
  14911. DZ1 = DZ1 / NDX;
  14912. COSL1 = ( (((DY1 * >Z3) - (DZ1 * >Y3)) ** 2 ) + (((DZ1 * >X3) - (DX1 * >Z3)) ** 2 ) + (((DX1 * >Y3) - (DY1 * >X3)) ** 2 )) ** 0.5 ;
  14913. SINL1 = (((COSL1 ** 2) * -1.) + 1.) ** 0.5 ;
  14914. ANGL1 = ATG COSL1 SINL1;
  14915. TITRE ' angle normales - point endoscope ' >PHI1;
  14916. EV3 = EVOL CHPO ANGL1 >LINC2 ;
  14917. DESS EV3;
  14918. * Le COSL1 est la pour tenir compte du fait que la resolution spatiale donnee
  14919. * par MIGOZZI est une resolution perpendiculaire a l'axe optique (que l'on
  14920. * projette sur l'aiguille.
  14921. Lint = Lint / (COS ANGL1) ;
  14922. TITRE '1/cos de l angle' >PHI1 ;
  14923. EV3 = EVOL CHPO ((COS ANGL1)**-1) >LINC2 ;
  14924. DESS EV3;
  14925. TITRE 'Pas d integration apres correction' >PHI1;
  14926. EV3 = EVOL CHPO Lint >LINC2 ;
  14927. DESS EV3;
  14928. FINSI ;
  14929. EMISSIV1 = 1.;
  14930. PLANKC1 = 3.74E-16 ;
  14931. PLANKC2 = 1.44E-2 ;
  14932. PLANKL = 4.E-6 ;
  14933. PLANKLM5 = PLANKL ** -5 ;
  14934. PI = 3.14159 ;
  14935. TEMP2 = REDU TEMP1 >LINC2;
  14936. LUMI1 = ( ((( EXP ((( TEMP2 * PLANKL) ** -1 ) * PLANKC2)) - 1.) * PI) ** -1 ) * EMISSIV1 * PLANKC1 * PLANKLM5 ;
  14937. * LUMI2 = LUMI1 * SINL1 ;
  14938. LUMI2 = LUMI1 * ETEND ;
  14939. EVTEML1 = EVOL ROUG CHPO LUMI1 SCAL >LINC2;
  14940. EVTEML2 = EVOL VERT CHPO LUMI2 SCAL >LINC2;
  14941. TAB3 = TABLE ;
  14942. TAB3.1 = 'MARQ CROI REGU MOT TITR LUMINES' ;
  14943. TAB3.2 = 'MARQ TRIA REGU MOT TITR LUMI*EG' ;
  14944. TAB3.3 = 'MARQ CARR REGU MOT TITR INTGLUMI' ;
  14945. * DESS (EVTEML1 ET EVTEML2) MIMA LEGE TAB3 ;
  14946. CHX1 = COOR 1 >LINC2;
  14947. EVTEMX = EVOL BLEU CHPO CHX1 SCAL >LINC2;
  14948. LIX1 = EXTR EVTEMX 'ORDO' ;
  14949. LIL1 = EXTR EVTEML1 'ORDO' ;
  14950. LIL2 = EXTR EVTEML2 'ORDO' ;
  14951. EVLXI1 = EVOL ROUG MANU LIX1 LIL1 ;
  14952. EVLXI2 = EVOL VERT MANU LIX1 LIL2 ;
  14953. * DESS (EVLXI1 ET EVLXI2) MIMA LEGE TAB3;
  14954. IL = 0 ;
  14955. REPETER BLUMI (NBNO >LINC2) ;
  14956. IL = IL + 1;
  14957. >PL1 = >LINC2 POINT IL ;
  14958. XL1 = COOR 1 >PL1 ;
  14959. XLINC2 = COOR 1 >LINC2 ;
  14960. >PASL = Lint EXTR 'SCAL' >PL1 ;
  14961. XLINF = XL1 - (>PASL / 2.) ;
  14962. XLSUP = XL1 + (>PASL / 2.);
  14963. MASL1 = MASQUE XLINC2 EGINFE XLSUP ;
  14964. MASL2 = MASQUE XLINC2 EGSUPE XLINF;
  14965. MASLT = MASL1 * MASL2;
  14966. LUMI3 = LUMI2 * MASLT ;
  14967. EVTEML3 = EVOL ROSE CHPO LUMI3 SCAL >LINC2;
  14968. LIL3 = EXTR EVTEML3 'ORDO' ;
  14969. EVLXI3 = EVOL ROUG MANU LIX1 LIL3;
  14970. * DESS (EVLXI3 ) ;
  14971. IRR = 0;
  14972. LIL3B = LIL3 ;
  14973. LIX1B = LIX1;
  14974. SI ( XLINF >EG (MINI LIX1)) ;
  14975. IRANGI1 = ( LIX1 MASQUE INFERIEUR SOMME XLINF) + 1;
  14976. IRANGI2 = IRANGI1 + 1;
  14977. VINF = @ITPLT LIX1 LIL2 'FIXE' XLINF ;
  14978. LIL3B = INSE LIL3B IRANGI1 0. ;
  14979. LIL3B = INSE LIL3B IRANGI2 VINF ;
  14980. LIX1B = INSE LIX1 IRANGI1 (XLINF - 1.E-6) ;
  14981. LIX1B = INSE LIX1B IRANGI2 XLINF;
  14982. IRR = 2;
  14983. FINSI;
  14984. SI ( XLSUP &lt;EG (MAXI LIX1)) ;
  14985. IRANGS1 = (MASQUE LIX1 INFERIEUR SOMME XLSUP) + 1 + IRR;
  14986. IRANGS2 = IRANGS1 + 1;
  14987. VSUP = @ITPLT LIX1 LIL2 'FIXE' XLSUP ;
  14988. LIL3B = INSE LIL3B IRANGS1 VSUP ;
  14989. LIL3B = INSE LIL3B IRANGS2 0 ;
  14990. LIX1B = INSE LIX1B IRANGS1 XLSUP ;
  14991. LIX1B = INSE LIX1B IRANGS2 (XLSUP + 1.E-6) ;
  14992. FINSI;
  14993. EVLXI3B = EVOL BLEU MANU LIX1B LIL3B;
  14994. * DESS (EVLXI3 ET EVLXI3B) ;
  14995. MOYLU3 = (INTG EVLXI3B) / >PASL ;
  14996. SI ( IL EGA 1 ) ;
  14997. CHPM3 = MANU CHPO >PL1 1 'SCAL' MOYLU3 NATURE DISCRET ;
  14998. SINON ;
  14999. CHPM3 =CHPM3 ET (MANU CHPO >PL1 1 'SCAL' MOYLU3 NATURE DISCRET) ;
  15000. FINSI;
  15001. FIN BLUMI ;
  15002. EVTEML4 = EVOL ROSE CHPO CHPM3 SCAL >LINC2;
  15003. LIL4 = EXTR EVTEML4 'ORDO' ;
  15004. EVLXI4 = EVOL ROSE MANU LIX1 LIL4 ;
  15005. TITRE ' Luminescence' >PHI1 ;
  15006. DESS (EVLXI1 ET EVLXI2 ET EVLXI4 ) MIMA LEGE TAB3 ;
  15007. CHT4 = (((LOG (((CHPM3 * PI) ** -1) * EMISSIV1 * PLANKC1 * PLANKLM5 + 1.)) * PLANKL) ** -1) * PLANKC2 ;
  15008. TEMP4 = REDU CHT4 >LINC2;
  15009. EVTE2 = EVOL VERT CHPO TEMP2 SCAL >LINC2;
  15010. EVTE4 = EVOL ROUG CHPO TEMP4 SCAL >LINC2;
  15011. LTE2 = EXTR EVTE2 'ORDO' ;
  15012. LTE4 = EXTR EVTE4 'ORDO' ;
  15013. TITRE ' Temperatures mesurees' ;
  15014. TAB1.EVLL4 = EVOL ROUG MANU LIX1 LTE4 ;
  15015. TITRE ' Temperatures initiales' ;
  15016. TAB1.EVLL2 = EVOL VERT MANU LIX1 LTE2 ;
  15017. TAB1.ANGLUMI = ANGL1 ;
  15018. MESS '>>>>>> FIN @LUMIN >>>>>>>>>>' ;
  15019. FINPROC ;
  15020.  
  15021.  
  15022. **** @MAGNB
  15023.  
  15024. DEBPROC @MAGNB TAB1*TABLE ;
  15025.  
  15026. ***********************************************************
  15027. * Procedure de calcul du champ magnetique en chaque point *
  15028. * d'un maillage donne. Alain MOAL (Fevrier 2001) *
  15029. ***********************************************************
  15030. *
  15031. MESS '---------------------------------> calling @MAGNB';
  15032. *
  15033. *--------------- VARIABLES D'ENTREE :
  15034. CHB0 = TAB1.<CARTE_B ;
  15035. GRILB0 = TAB1.<GRILLE_B ;
  15036. MAIL1 = TAB1.<MAILLAGE_B ;
  15037. *------------------------------------
  15038. *TRAC (MAIL1 ET GRILB0) ;
  15039. CHEL1 = CHAN CHAM CHB0 GRILB0 ;
  15040. CHPO1 = PROI MAIL1 CHEL1 1.E-4;
  15041. BR = EXCO 'BR' CHPO1 ;
  15042. BZ = EXCO 'BZ' CHPO1 ;
  15043. BPHI = EXCO 'BPHI' CHPO1 ;
  15044. *
  15045. MESS '---------------------------------> exiting @MAGNB';
  15046. FINPROC BR BZ BPHI ;
  15047.  
  15048. 'DEBPROC' MATHPLAS TABTEM*'TABLE' TEPMAT*'TABLE' ;
  15049. *-----------------------------------------------------------------*
  15050. * *
  15051. * M A T H P L A S *
  15052. * --------------- *
  15053. * *
  15054. * Construction des champs d{finissant un mat{riau pour un *
  15055. * calcul thermoplastique. Pour chaque {l{ment, les valeurs *
  15056. * des coefficients YOUN, NU, RHO, ALPH ainsi que la courbe *
  15057. * de traction seront {tablis en fonction de la carte de *
  15058. * temp{rature et du r{seau de courbes de traction. *
  15059. * *
  15060. * En entr{e : *
  15061. * *
  15062. * TABTEM Table contenant : *
  15063. * indice 'NCHAMP' nombre de champs thermiques (ENTIER) *
  15064. * indice i carte de temp{rature @ l'instant n\9Bi *
  15065. * (CHPOINT) *
  15066. * indice 'PALIER' option : n\9B du champ @ partir duquel *
  15067. * il y a un palier dans le chargement *
  15068. * et reste inchang{ apr}s (ENTIER) *
  15069. * TEPMAT Table contenant : *
  15070. * indice 'MAILLAGE' le maillage de la structure *
  15071. * indice 'NBPTRAC' le nombre de points contenus dans *
  15072. * les courbes de traction (ENTIER) *
  15073. * indice 'DEFO' la table TABEPS contenant : *
  15074. * indice i les abscisses de la i-}me normale *
  15075. * aux courbes de traction (LISTREEL) *
  15076. * indice 'CONT' la table TABSIG contenant : *
  15077. * indice i les ordonn{es de la i-}me normale *
  15078. * aux courbes de traction (LISTREEL) *
  15079. * Remarque : i varie entre 1 et NBPTRAC *
  15080. * indice 'LISTEMP' liste des temp{ratures correspondant *
  15081. * aux courbes de traction (LISTREEL) *
  15082. * indice 'EVOALPH' ALPHA(T) (EVOLUTION) ou *
  15083. * indice 'VALALPH' ALPHA (REEL) *
  15084. * indice 'EVONU' NU(T) (EVOLUTION) ou *
  15085. * indice 'VALNU' NU (REEL) *
  15086. * indice 'EVORHO' RHO(T) (EVOLUTION) ou *
  15087. * indice 'VALRHO' RHO (REEL) *
  15088. * Remarque : si objet EVOLUTION : 'ALPH' 'NU' ou *
  15089. * 'RHO' en abscisse et 'T' en ordonn{e *
  15090. * En sortie : *
  15091. * *
  15092. * indice 'MODELE' objet mod}le (MMODEL) *
  15093. * indice 'MATERIAU' table contenant : *
  15094. * indice i champ d{finissant le mat{riau au *
  15095. * i-}me pas de calcul (MCHAML) *
  15096. * *
  15097. * Remarques : 1) l'objet mod}le sera obligatoirement du type *
  15098. * 'MECANIQUE' 'ELASTIQUE' 'PLASTIQUE' 'ISOTROPE' 'typelem' *
  15099. * et il sera cr{{ une fois pour toutes; *
  15100. * 2) le module d'Young {tant la pente @ l'origine *
  15101. * de la courbe de traction, sa donn{e n'est pas n{cessaire. *
  15102. * *
  15103. * Denis ROBERT, le 14 f{vrier 1992. *
  15104. *-----------------------------------------------------------------*
  15105. * si IMESS = VRAI : impressions des champs d{finissant le mat{riau
  15106. IMESS = FAUX ;
  15107. *
  15108. GEO1 = TEPMAT.'MAILLAGE' ;
  15109. NBPTRAC = TEPMAT.'NBPTRAC' ;
  15110. LISTEMP = TEPMAT.'LISTEMP' ;
  15111. TABEPS = TEPMAT.'DEFO' ;
  15112. TABSIG = TEPMAT.'CONT' ;
  15113. TABMAT = TABLE ;
  15114. TABMOD = TABLE ;
  15115. NTHER = TABTEM.'NCHAMP' ;
  15116. *
  15117. 'SI' ( 'EXISTE' TABTEM 'PALIER' ) ;
  15118. NTHER = TABTEM.'PALIER' ;
  15119. 'FINSI' ;
  15120. 'SI' ( 'EXISTE' TEPMAT 'VALALPH' ) ;
  15121. IALPH = 1 ; ALPIEL1 = TEPMAT.'VALALPH' ;
  15122. 'SINON' ;
  15123. IALPH = 2 ;
  15124. LISALP1 = 'EXTR' TEPMAT.'EVOALPH' 'ALPH' ;
  15125. LISTE2 = 'EXTR' TEPMAT.'EVOALPH' 'T' ;
  15126. 'FINSI' ;
  15127. 'SI' ( 'EXISTE' TEPMAT 'VALRHO' ) ;
  15128. IRHO = 1 ; RHOIEL1 = TEPMAT.'VALRHO' ;
  15129. 'SINON' ;
  15130. IRHO = 2 ;
  15131. LISRHO1 = 'EXTR' TEPMAT.'EVORHO' 'RHO' ;
  15132. LISTE3 = 'EXTR' TEPMAT.'EVORHO' 'T' ;
  15133. 'FINSI' ;
  15134. 'SI' ( 'EXISTE' TEPMAT 'VALNU' ) ;
  15135. INU = 1 ; NUIEL1 = TEPMAT.'VALNU' ;
  15136. 'SINON' ;
  15137. INU = 2 ;
  15138. LISNU1 = 'EXTR' TEPMAT.'EVONU' 'NU' ;
  15139. LISTE4 = 'EXTR' TEPMAT.'EVONU' 'T' ;
  15140. 'FINSI' ;
  15141. 'SI' ( IMESS ) ;
  15142. 'SAUTER' 1 'LIGNE' ;
  15143. 'MESS' '*** MAt{riau THermoPLAStique ***' ;
  15144. 'SAUTER' 1 'LIGNE' ;
  15145. 'FINSI' ;
  15146. *
  15147. * Types d'{l{ments-finis du maillage / Nombre de types / Nombre
  15148. * d'{l{ments d'un type
  15149. *
  15150. LESTYPS = GEO1 'ELEM' 'TYPE' ;
  15151. NBTYP1 = 'DIME' LESTYPS ;
  15152. NBTYPEL = 'NBEL' GEO1 LESTYPS ;
  15153. *
  15154. * Boucle sur les types d'{l{ments-finis
  15155. *
  15156. ITYP1 = 0 ;
  15157. 'REPETER' BOUTYPEL NBTYP1 ;
  15158. ITYP1 = ITYP1 + 1 ;
  15159. NBEL1 = 'EXTRAIRE' NBTYPEL ITYP1 ;
  15160. NOMEL1 = 'EXTRAIRE' LESTYPS ITYP1 ;
  15161. *
  15162. * Boucle sur les {l{ments du maillage
  15163. *
  15164. IEL = 0 ;
  15165. 'REPETER' BOUCELEM NBEL1 ;
  15166. IEL = IEL + 1 ;
  15167. 'SI' ( NBTYP1 '>EG' 2 ) ;
  15168. IELEM1 = GEO1 'ELEM' NOMEL1 IEL ;
  15169. 'SINON' ;
  15170. IELEM1 = GEO1 'ELEM' IEL ;
  15171. 'FINSI' ;
  15172. *
  15173. * Boucle sur la liste de champs de temp{rature
  15174. *
  15175. ITHER = 0 ;
  15176. 'REPETER' BOUCTHER NTHER ;
  15177. ITHER = ITHER + 1 ;
  15178. CHTER = TABTEM.ITHER ;
  15179. CHTEL1 = 'REDU' CHTER IELEM1 ;
  15180. TMOY = 0. ;
  15181. NNIEL1 = 'NBEL' IELEM1 ;
  15182. *
  15183. * Boucle sur les points du i-}me {l{ment
  15184. *
  15185. J1 = 0 ;
  15186. 'REPETER' BOUCPOIN NNIEL1 ;
  15187. J1 = J1 + 1 ;
  15188. POIN1 = IELEM1 'POIN' J1 ;
  15189. TEXTR = 'EXTR' CHTEL1 'T' POIN1 ;
  15190. TMOY = TMOY + TEXTR ;
  15191. 'FIN' BOUCPOIN ;
  15192. TMOY = TMOY / NNIEL1 ;
  15193. 'SI' ( IALPH 'EGA' 2 ) ;
  15194. ALPIEL1 = 'IPOL' TMOY LISTE2 LISALP1 ;
  15195. 'FINSI' ;
  15196. 'SI' ( IRHO 'EGA' 2 ) ;
  15197. RHOIEL1 = 'IPOL' TMOY LISTE3 LISRHO1 ;
  15198. 'FINSI' ;
  15199. 'SI' ( INU 'EGA' 2 ) ;
  15200. NUIEL1 = 'IPOL' TMOY LISTE4 LISNU1 ;
  15201. 'FINSI' ;
  15202. *
  15203. * Boucle sur le nombre de points des courbes de traction
  15204. *+*
  15205. IPTRAC = 0 ;
  15206. LEPSIEL1 = 'PROG' 0. ;
  15207. LSIGIEL1 = 'PROG' 0. ;
  15208. 'REPETER' BOUTRAC NBPTRAC ;
  15209. IPTRAC = IPTRAC + 1 ;
  15210. XX = 'IPOL' TMOY LISTEMP TABEPS.IPTRAC ;
  15211. YY = 'IPOL' TMOY LISTEMP TABSIG.IPTRAC ;
  15212. *
  15213. * Le module d'Young est la pente de la courbe de traction
  15214. *
  15215. 'SI' ( IPTRAC 'EGA' 1 ) ;
  15216. YOUIEL1 = YY / XX ;
  15217. 'FINSI' ;
  15218. LEPSIEL1 = LEPSIEL1 'ET' ( 'PROG' XX ) ;
  15219. LSIGIEL1 = LSIGIEL1 'ET' ( 'PROG' YY ) ;
  15220. 'FIN' BOUTRAC ;
  15221. TRAIEL1 = 'EVOL' 'MANU' 'DEFO' LEPSIEL1 'CONT' LSIGIEL1 ;
  15222. lsm1 = LSIGIEL1 enle 1 ;
  15223. lep1 = (LEPSIEL1 enle 1) - (lsm1 / YOUIEL1) ;
  15224. EVECRO1 = evol vert manu esp lep1 sig lsm1 ;
  15225. dess (TRAIEL1 et EVECRO1) titr ' Courbes de traction et d ecrouissage (vert)' ;
  15226. 'SI' ( IMESS ) ;
  15227. 'MESS' '*** ELEMENT : ' IEL ' CHAMP : ' ITHER ' ***';
  15228. 'MESS' 'TMOY : ' TMOY ;
  15229. 'MESS' 'YOUNG : ' YOUIEL1 ;
  15230. 'MESS' 'ALPHA : ' ALPIEL1 ;
  15231. 'MESS' 'RHO : ' RHOIEL1 ;
  15232. 'MESS' 'NU : ' NUIEL1 ;
  15233. 'MESS' 'COURBE DE TRACTION (SIGMA / EPSILON) : ' ;
  15234. 'LISTE' LSIGIEL1 ;'LISTE' LEPSIEL1 ;
  15235. 'FINSI' ;
  15236. 'SI' ( IEL 'EGA' 1 ) ;
  15237. 'SI' ( ITHER 'EGA' 1 ) ;
  15238. MODTOT = 'MODE' IELEM1 'MECANIQUE' 'ELASTIQUE' 'PLASTIQUE' 'ISOTROPE' NOMEL1 ;
  15239. TABMAT.ITHER = 'MATE' MODTOT 'YOUN' YOUIEL1 'NU' NUIEL1 'RHO' RHOIEL1 'ALPH' ALPIEL1 'ECRO' EVECRO1 ;
  15240. 'SINON' ;
  15241. TABMAT.ITHER = 'MATE' MODTOT 'YOUN' YOUIEL1 'NU' NUIEL1 'RHO' RHOIEL1 'ALPH' ALPIEL1 'ECRO' EVECRO1 ;
  15242. 'FINSI' ;
  15243. 'SINON' ;
  15244. 'SI' ( ITHER 'EGA' 1 ) ;
  15245. MODIEL1 = 'MODE' IELEM1 'MECANIQUE' 'ELASTIQUE' 'PLASTIQUE' 'ISOTROPE' NOMEL1 ;
  15246. MODTOT = MODTOT 'ET' MODIEL1 ;
  15247. MATIEL1 = 'MATE' MODIEL1 'YOUN' YOUIEL1 'NU' NUIEL1 'RHO' RHOIEL1 'ALPH' ALPIEL1 'ECRO' EVECRO1 ;
  15248. TABMAT.ITHER = TABMAT.ITHER 'ET' MATIEL1 ;
  15249. 'SINON' ;
  15250. MATIEL1 = 'MATE' MODIEL1 'YOUN' YOUIEL1 'NU' NUIEL1 'RHO' RHOIEL1 'ALPH' ALPIEL1 'ECRO' EVECRO1 ;
  15251. TABMAT.ITHER = TABMAT.ITHER 'ET' MATIEL1 ;
  15252. 'FINSI' ;
  15253. 'FINSI' ;
  15254. 'FIN' BOUCTHER ;
  15255. 'FIN' BOUCELEM ;
  15256. 'FIN' BOUTYPEL ;
  15257. 'SI' ( 'EXISTE' TABTEM 'PALIER' ) ;
  15258. NTHERTOT = TABTEM.'NCHAMP' ;
  15259. INUM = NTHER ;
  15260. 'REPETER' BOUCPAL (NTHERTOT - NTHER) ;
  15261. INUM = INUM + 1 ;
  15262. TABMAT.INUM = TABMAT.NTHER ;
  15263. 'SI' ( IMESS ) ;
  15264. 'MESS' 'OPTION PALIER : CREATION DE TABMAT.' INUM ;
  15265. 'FINSI' ;
  15266. 'FIN' BOUCPAL ;
  15267. 'FINSI' ;
  15268. TEPMAT.'MODELE' = MODTOT ;
  15269. TEPMAT.'MATERIAU' = TABMAT ;
  15270. 'SI' ( IMESS ) ;
  15271. 'SAUTER' 1 'LIGNE' ;
  15272. 'MESS' '*** FIN DE MATHPLAS ***' ;
  15273. 'SAUTER' 1 'LIGNE' ;
  15274. 'FINSI' ;
  15275. *
  15276. 'FINPROC' TEPMAT ;
  15277. **** @MATLAB
  15278. DEBPROC @MATLAB EVO1*EVOLUTION ;
  15279. ABSC1 = EXTR EVO1 ABSC ;
  15280. N_COUR1 = DIME EVO1 ;
  15281. N_VALE1 = DIME ABSC1 ;
  15282.  
  15283.  
  15284.  
  15285.  
  15286. I1 = 1 ;
  15287. REPETER BOUC1 N_VALE1 ;
  15288. I2 = 1 ;
  15289. LLIST1 = EXTR ABSC1 I1 ;
  15290. REPETER BOUC2 N_COUR1 ;
  15291. VALEI2 = EXTR (EXTR EVO1 ORDO I2) I1 ;
  15292. LLIST1 = CHAIN LLIST1 ' ' VALEI2 ;
  15293. I2 = I2 + 1 ;
  15294. FIN BOUC2 ;
  15295. I1 = I1 + 1 ;
  15296. MESS LLIST1 ;
  15297. FIN BOUC1 ;
  15298.  
  15299. FINPROC ;
  15300. *-----------------------------------------------------------------------
  15301. *23456789012345678901234567890123456789012345678901234567890123456789012
  15302. * 1 2 3 4 5 6 7
  15303. *
  15304. *
  15305. *********************************************************************
  15306. * PROCEDURE FRENET3D : CALCUL DU REPERE DE FRENET LE LONG D'UNE LIGNE
  15307. * EN 3D
  15308. *********************************************************************
  15309. *
  15310. DEBPROC @FRENE3D LIG_1*MAILLAGE SURF_2/MAILLAGE VEC_1/POINT MOT_DIR/MOT LOG_1/LOGIQUE;
  15311. MESS '---------------------------------> entree dans FRENET3D';
  15312. V1 = VALEUR DIME ;
  15313. CH_T CH_N CH_B = FRENET LIG_1 ;
  15314. SI (V1 > 2) ;
  15315. A11 = EXCO 'TX' CH_T 'P11' ;
  15316. A12 = EXCO 'TY' CH_T 'P12' ;
  15317. A13 = EXCO 'TZ' CH_T 'P13' ;
  15318. A21 = EXCO 'NX' CH_N 'P21' ;
  15319. A22 = EXCO 'NY' CH_N 'P22' ;
  15320. A23 = EXCO 'NZ' CH_N 'P23' ;
  15321. A31 = EXCO 'BX' CH_B 'P31' ;
  15322. A32 = EXCO 'BY' CH_B 'P32' ;
  15323. A33 = EXCO 'BZ' CH_B 'P33' ;
  15324. CH_R = A11 ET A12 ET A13 ET A21 ET A22 ET A23 ET A31 ET A32 ET A33 ;
  15325. SI ( NON ( EXISTE LOG_1 )) ; LOG_1 = FAUX ; FINSI ;
  15326. SI LOG_1 ;
  15327. COX COY COZ = COOR LIG_1 ;
  15328. XMAX = MAXI COX ;
  15329. YMAX = MAXI COY ;
  15330. ZMAX = MAXI COZ ;
  15331. XMIN = MINI COX ;
  15332. YMIN = MINI COY ;
  15333. ZMIN = MINI COZ ;
  15334. DL = (((XMAX - XMIN)**2) + ((YMAX -YMIN)**2))**0.5 ;
  15335. AMP = DL/10. ;
  15336. VT = VECT CH_T AMP TX TY TZ ROUGE ;
  15337. VN = VECT CH_N AMP NX NY NZ VERT ;
  15338. VP = VECT CH_P AMP PX PY PZ BLEU ;
  15339. TITRE 'REPERE DE FRENET DE LA LIGNE ' ;
  15340. OEIL1 = (VEC_1 *100000.) PLUS ( 5e4 5e4 5e4 ) ;
  15341. TRAC QUAL OEIL1 (VT ET VN ET VP ) LIGN_1 ;
  15342. FINSI ;
  15343. FINSI ;
  15344. *FINPROC CH_R ;
  15345. SI (V1 &lt;EG 2) ;
  15346. A11 = EXCO 'TX' CH_T 'P11' ;
  15347. A12 = EXCO 'TY' CH_T 'P12' ;
  15348. A21 = EXCO 'NX' CH_N 'P21' ;
  15349. A22 = EXCO 'NY' CH_N 'P22' ;
  15350. CH_R = A11 ET A12 ET A21 ET A22 ;
  15351. SI LOG_1 ;
  15352. COX COY = COOR LIG_1 ;
  15353. XMAX = MAXI COX ;
  15354. YMAX = MAXI COY ;
  15355. XMIN = MINI COX ;
  15356. YMIN = MINI COY ;
  15357. DL = (((XMAX - XMIN)**2) + ((YMAX -YMIN)**2))**0.5 ;
  15358. AMP = DL/10. ;
  15359. VT = VECT CHT AMP TX TY ROUGE ;
  15360. VN = VECT CHN AMP NX NY VERT ;
  15361. TITRE 'REPERE DE FRENET DE LA LIGNE ' ;
  15362. TRAC QUAL (VT ET VN) LIGN_1 ;
  15363. FINSI ;
  15364. FINSI ;
  15365. MESS '---------------------------------> sortie de FRENET3D';
  15366. FINPROC CH_R ;
  15367.  
  15368. *-----------------------------------------------------------------------
  15369. *
  15370. *----------Fin de la procedure FRENET3D
  15371. *
  15372. *----------Debut de la procedure INDSCHL
  15373. *
  15374. *-----------------------------------------------------------------------
  15375. *23456789012345678901234567890123456789012345678901234567890123456789012
  15376. * 1 2 3 4 5 6 7
  15377. ************************************************************************
  15378. * Organisation :
  15379. * --------------
  15380. * Une boucle sur les indices de la table entree teste s'ils sont reels
  15381. * ou pas. Si l'indice est reel, on le stocke a la suite des autres
  15382. * dans la liste des reels.
  15383.  
  15384. 'DEBPROC' @INDSCHL TA_1*'TABLE ' ;
  15385. *
  15386. TA_2 = INDE TA_1 ;
  15387. P_1 = PROG ;
  15388. I1 = 0 ;
  15389. REPETER BO_1 ( DIME TA_2 ) ;
  15390. I1 = I1 + 1 ;
  15391. IND_1 = TA_2 . I1 ;
  15392. TYP_1 = TYPE IND_1 ;
  15393. SI ( EGA TYP_1 'FLOTTANT') ;
  15394. P_1 = P_1 ET ( PROG IND_1 ) ;
  15395. SINON ;
  15396. MESS '>>> TYPE DE L INDICE : ' TYP_1 'VALEUR :' IND_1 ;
  15397. MESS '>>> ON NE FAIT RIEN ' ;
  15398. FINSI ;
  15399. FIN BO_1 ;
  15400. FINPROC P_1 ;
  15401.  
  15402. *-----------------------------------------------------------------------
  15403. *
  15404. *----------Fin de la procedure @INDSCHL
  15405. *
  15406. *----------Debut de la procedure EPSCHL
  15407. *
  15408. *-----------------------------------------------------------------------
  15409. *23456789012345678901234567890123456789012345678901234567890123456789012
  15410. * 1 2 3 4 5 6 7
  15411. ************************************************************************
  15412.  
  15413. 'DEBPROC' EPSCHL MOD_1*MMODEL SI_13*MCHAML MAT_1/MCHAML TE0*CHPOINT TE1*CHPOINT TAB1/'TABLE ' ;
  15414. MESS '---------------------------------> entree dans EPSCHL';
  15415. *ENTREES TAB1.ZONE_MAT
  15416. * .MODL_MAT .TETMAT .TEXTMECA .VIEW_P
  15417. *SORTIES .MATTOT .VIEW_P
  15418. *
  15419. SI (( NON ( EXISTE MAT_1)) ET ( EXISTE TAB1)) ;
  15420. I1 = 0 ;
  15421. REPETER BOMA11 ;
  15422. I1 = I1 + 1 ;
  15423. SI ( EXISTE (TAB1.ZONE_MAT) I1 ) ;
  15424. MO1 = TAB1.MODL_MAT. I1 ;
  15425. TM_1 = ( REDU TE1 TAB1.ZONE_MAT.I1 ) ;
  15426. Y_1 = VARI TM_1 TAB1.TETMAT.MO1.YOUN YOUN ;
  15427. NU_1 = VARI TM_1 TAB1.TETMAT.MO1.NU NU ;
  15428. AL_1 = VARI TM_1 TAB1.TETMAT.MO1.ALPH ALPH ;
  15429. NU_1 = CHANGER CHAM NU_1 MO1 'RIGIDITE' ;
  15430. Y_1 = CHANGER CHAM Y_1 MO1 'RIGIDITE' ;
  15431. AL_1 = CHANGER CHAM AL_1 MO1 'RIGIDITE' ;
  15432. TEX1 = TEXTE 'YOUN Y_1 NU NU_1 ALPH AL_1' ;
  15433. IMOTM1 = DIME (MOTS TAB1.TEXTMECA.I1) ;
  15434. SI ( IMOTM1 EGA 5 ) ;
  15435. TEX1 = TEXTE TEX1 'SIGY YM_1 ' ;
  15436. TITRE 'MAT' I1 ' YIELD MODULUS' ;
  15437. YM_1 = VARI TM_1 TAB1.TETMAT.MO1.SIGY SIGY ;
  15438. YM_1 = CHANGER CHAM YM_1 MO1 'RIGIDITE' ;
  15439. TEX1 = TEXTE TEX1 'H H_1 ' ;
  15440. H_1 = VARI TM_1 TAB1.TETMAT.MO1.H H ;
  15441. H_1 = CHANGER CHAM H_1 MO1 'RIGIDITE' ;
  15442. FINSI ;
  15443. MA1 = MATE MO1 TEX1 ;
  15444. SINON ;
  15445. QUITTER BOMA11 ;
  15446. FINSI ;
  15447. SI ( I1 EGA 1 ) ;
  15448. MOD_1 = MO1 ;
  15449. MAT_2 = MA1 ;
  15450. SINON ;
  15451. MOD_1 = MOD_1 ET MO1 ;
  15452. MAT_2 = MAT_2 ET MA1 ;
  15453. FINSI ;
  15454. FIN BOMA11 ;
  15455. SINON ;
  15456. MAT_2 = MAT_1 ;
  15457. FINSI ;
  15458. TAB1.MATTOT = MAT_2 ;
  15459. SI_11 = THETA MOD_1 MAT_2 ( TE1 - TE0 ) ;
  15460. FO1 = BSIGMA MOD_1 SI_11 ;
  15461. SI_12 = SI_13 + SI_11 ;
  15462. EPS_1 = ELAS MOD_1 SI_12 MAT_2 ;
  15463. * ici il faudrait extraire le alpha de mat_2
  15464. * multiplier par ( TE1 - TE0 ) et en faire un EPZZ
  15465. * a rajouter a EPS_1
  15466. AL_P1 = EXCO 'ALPH' MAT_2 'SCAL' ;
  15467. AL_P1 = CHAN 'TYPE' AL_P1 'DEFORMATIONS' ;
  15468. * MAIL1 = EXTR AL_P1 'MAIL' ;
  15469. TCACH = TEXT ' ' ;
  15470. SI ( NON (EXISTE TAB1 VIEW_P )) ;
  15471. TAB1.VIEW_P = TEXT ' ' ;
  15472. TEX2 = TEXT ' ' ;
  15473. TCACH = TEXT ' ' ;
  15474. SI ( EGA ( VALE DIME) 3 ) ;
  15475. TAB1.VIEW_P = 1.E8 1.E8 1.E8 ;
  15476. TCACH = TEXT ' CACH ' ;
  15477. FINSI ;
  15478. FINSI ;
  15479.  
  15480. * OPTI TRAC X ;
  15481. * TRAC CACH TAB1.VIEW_P MAIL1
  15482. ;
  15483. TT_1 = CHAN 'CHAM' ( NOMC 'SCAL' ( TE1 - TE0 )) MOD_1 'RIGIDITE' ;
  15484. TT_1 = CHAN 'TYPE' TT_1 'DEFORMATIONS' ;
  15485. TT_1 = ( AL_P1 * 0.) + TT_1 ;
  15486. * MAIL2 = EXTR TT_1 'MAIL' ;
  15487. * TRAC CACH TAB1.VIEW_P MAIL2 ;
  15488. E_ZZ1 = AL_P1 * TT_1 ;
  15489. E_ZZ1 = CHAN 'STRESSES' MOD_1 E_ZZ1 ;
  15490. E_ZZ1 = EXCO 'SCAL' E_ZZ1 'EPZZ' ;
  15491. EPS_1 = EPS_1 ET E_ZZ1 ;
  15492. MESS '---------------------------------> sortie de EPSCHL';
  15493. FINPROC EPS_1 ;
  15494.  
  15495. *-----------------------------------------------------------------------
  15496. *
  15497. *----------Fin de la procedure EPSCHL
  15498. *
  15499. *----------Debut de la procedure MECASCH1
  15500. *
  15501. *ENTREES TAB1.ZONE_MAT
  15502. * .MODL_MAT .TETMAT .TEXTMECA .BLOCAGE
  15503. * .CHPOTHETA .DEFO_PLANE_GENE
  15504. * .MAXITERATION .L_BAS
  15505. *E/S .VIEW_P .LIS_ATRAITER .MAXITERATION
  15506. * .ITERATION .CHA1 .VIEW_P2
  15507. *SORTIES .MATTOT .L_CONTOUR .PLASTIQUE .DEFO_PLANE_GENE
  15508. * .S_TOTAL .MODTOT .MATTOT
  15509. * .THERMIQUE .NZ
  15510. *-----------------------------------------------------------------------
  15511. *23456789012345678901234567890123456789012345678901234567890123456789012
  15512. * 1 2 3 4 5 6 7
  15513. ************************************************************************
  15514.  
  15515.  
  15516. 'DEBPROC' MECASCH1 TAB1*'TABLE ' ;
  15517. MESS '---------------------------------> entree dans MECASCH1';
  15518. *OPTI ECHO 0 ;
  15519.  
  15520. V1 = VALEUR 'DIME' ;
  15521. SI ( V1 EGA 2) ;
  15522. TFRONT1 = TEXT ' CONTOUR' ;
  15523. TCACH = TEXT ' ' ;
  15524. SINON ;
  15525. TFRONT1 = TEXT ' ENVELOP' ;
  15526. TCACH = TEXT ' CACH ' ;
  15527. FINSI ;
  15528.  
  15529. SI ( NON (EXISTE TAB1 VIEW_P )) ;
  15530. TAB1.VIEW_P = TEXT ' ' ;
  15531. SI ( EGA ( VALE DIME) 3 ) ;
  15532. TAB1.VIEW_P = 1.E8 1.E8 1.E8 ;
  15533. FINSI ;
  15534. FINSI ;
  15535.  
  15536. *SI ( NON ( EXISTE TAB1 MECANIQUE )) ;
  15537. * TAB1.MECANIQUE = FAUX ;
  15538. * MESS ' >>>>>si vous voulez un calcul mecanique ' ;
  15539. * MESS ' >>>>>faire TAB1.MECANIQUE = VRAI ' ;
  15540. *FINSI ;
  15541. *1
  15542. *SI ( TAB1.MECANIQUE ) ;
  15543. * SI ( NON ( EXISTE TAB1 CHPOTHETA )) ;
  15544. * TAB1.CHPOTHETA = TABLE ;
  15545. * FINSI ;
  15546. * XI11 = 0. ;
  15547. SI ( NON ( EXISTE TAB1 LIS_ATRAITER )) ;
  15548. TAB1. LIS_ATRAITER = @INDSCHL (TAB1.CHPOTHETA) ;
  15549. FINSI ;
  15550. LIS1 = TAB1. LIS_ATRAITER ;
  15551. * MESS '>>>> cas a traiter ' ;
  15552. * LIST LIS1 ;
  15553. * SI ( EXISTE TAB1 CHPT_INI ) ;
  15554. * TAB1.CHPOTHETA . 0. = TAB1 . CHPT_INI ;
  15555. * LIS1 = PROG XI11 ;
  15556. * SINON ;
  15557. * XI11 = -1. ;
  15558. * LIS1 = PROG ;
  15559. * FINSI ;
  15560. * SI ( EXISTE TAB1 CHPT_FINAL ) ;
  15561. * SI ( NON ( EXISTE TAB1 CHPT_INI ) ) ;
  15562. * MESS '>>>> IL FALLAIT DONNER UN CHAMP INITIAL >>>>>' ;
  15563. * MESS '>>>> CELA VA SE PLANTER >>>>>' ;
  15564. * FINSI ;
  15565. * XI11 = XI11 + 1. ;
  15566. * MESS '>>>>0.1 ' ;
  15567. * LIS1 = LIS1 ET ( PROG XI11 ) ;
  15568. * TAB1.CHPOTHETA . XI11 = TAB1 . CHPT_FINAL ;
  15569. * FINSI ;
  15570. * SI ( (TAB1 . PERMANENT) EGA VRAI ) ;
  15571. * I11 = 0 ;
  15572. * REPETER BOCAP1 ( DIME ( TAB1 . LIS_NO_ATRAITER) ) ;
  15573. * SI ( EXISTE TAB1 CHPT_FINAL ) ; QUITTER BOCAP1; FINSI ;
  15574. * XI11 = XI11 + 1. ;
  15575. * MESS '>>>>0.2 ' ;
  15576. * I11 = I11 + 1 ;
  15577. * I1 = EXTR TAB1.LIS_NO_ATRAITER I11 ;
  15578. * TAB1.CHPOTHETA . XI11 = TAB1.I1 ;
  15579. * LIS1 = LIS1 ET ( PROG XI11 ) ;
  15580. * FIN BOCAP1 ;
  15581. * FINSI ;
  15582. * SI ( ( ((TAB1 . TRANSITOIRE) EGA VRAI ) ET
  15583. * (TAB1 . PERMANENT) EGA FAUX ) ) ;
  15584. * REPETER BOCAT1 ;
  15585. * SI ( EXISTE TAB1 CHPT_FINAL); QUITTER BOCAT1; FINSI ;
  15586. * XI11 = XI11 + 1. ;
  15587. * MESS '>>>>0.3 ' ;
  15588. * I11 = ENTIER XI11 ;
  15589. * SI ( NON ( EXISTE TAB1 I11 )); QUITTER BOCAT1; FINSI ;
  15590. * TAB1.CHPOTHETA . XI11 = TAB1. I11 ;
  15591. * LIS1 = LIS1 ET ( PROG XI11 ) ;
  15592. * FIN BOCAT1 ;
  15593. * FINSI ;
  15594. *
  15595. * XF1 = PROG (DIME LIS1) * 1. ;
  15596. * F1 = FORCE FY 0. ( TAB1 . L_BAS ) ;
  15597. * CHA1 = CHAR F1 ( EVOL MANU LIS1 XF1 ) ;
  15598. IPP1 = 0 ;
  15599. REPETER BOMA10 ;
  15600. IPP1 = IPP1 + 1 ;
  15601. SI ( EXISTE (TAB1.ZONE_MAT) IPP1 ) ;
  15602. SI ( IPP1 EGA 1 ) ;
  15603. STOT1 = TAB1.ZONE_MAT . IPP1 ;
  15604. CONTT1 = TFRONT1 (TAB1.ZONE_MAT . IPP1 ) ;
  15605. SINON ;
  15606. STOT1 = STOT1 ET (TAB1.ZONE_MAT . IPP1) ;
  15607. CONTT1 = CONTT1 ET ( TFRONT1 (TAB1.ZONE_MAT. IPP1)) ;
  15608. FINSI ;
  15609. SINON ;
  15610. QUITTER BOMA10 ;
  15611. FINSI ;
  15612. FIN BOMA10 ;
  15613. TRAC TCACH TAB1.VIEW_P CONTT1 ;
  15614. SI ( EXISTE TAB1 VIEW_P2 ) ;
  15615. TRAC TCACH TAB1.VIEW_P2 CONTT1 ;
  15616. FINSI ;
  15617. TAB1.L_CONTOUR = CONTT1 ;
  15618. TAB1.S_TOTAL = STOT1 ;
  15619. * on calcule une temperature moyenne de l intervalle
  15620. CHP_TM1 = ( ((TAB1.CHPOTHETA .(EXTR 1 LIS1)) + (TAB1.CHPOTHETA .(EXTR (DIME LIS1) LIS1))) * 0.5 ) ;
  15621. TAB1.>CHP_TM1 = CHP_TM1 ;
  15622. @DEFMAT TAB1 ;
  15623. MOD_1 = TAB1.MODTOT;
  15624. MAT_1 = TAB1.MATTOT ;
  15625. RIG_1 = RIGI MOD_1 MAT_1 ;
  15626. SI ( NON (EXISTE TAB1 PLASTIQUE )) ;
  15627. TAB1.PLASTIQUE = VRAI ;
  15628. FINSI ;
  15629. SI ( NON (EXISTE TAB1 DEFO_PLANE_GENE )) ;
  15630. TAB1.DEFO_PLANE_GENE = FAUX ;
  15631. FINSI ;
  15632.  
  15633.  
  15634. MESS '>>>>>>> 2 >>>>>>' ;
  15635. SI ( (TAB1.PLASTIQUE ) ET ( NON TAB1.DEFO_PLANE_GENE )) ;
  15636. * SI ( NON (EXISTE TAB1 PRECISION )) ;
  15637. * TAB1.PRECISION = 0.01 ;
  15638. * FINSI ;
  15639. MESS '>>>>>>> 2.1 >>>>>>' ;
  15640. SI ( NON ( EXISTE TAB1 MAXITERATION ) ) ;
  15641. TAB1.MAXITERATION = 100 ;
  15642. FINSI ;
  15643. * SI ( NON (EXISTE TAB1 ACCELERATION) ) ;
  15644. * TAB1.ACCELERATION = 20 ;
  15645. * FINSI ;
  15646. TAB1.THERMIQUE = VRAI ;
  15647. TAB1.ITERATION = KSI ;
  15648.  
  15649.  
  15650. SI (NON (EXISTE TAB1 CHA1)) ;
  15651. XF1 = PROG (DIME LIS1) * 1. ;
  15652. F1 = FORCE FY 0. (TAB1 . L_BAS) ;
  15653. CHARG1 = CHAR F1 ( EVOL MANU LIS1 XF1 ) ;
  15654. * TAB1.'CHA1' = CHA1 ;
  15655. SINON ;
  15656. CHARG1 = TAB1.'CHA1' ;
  15657. FINSI ;
  15658.  
  15659. TAB1.NZ = 0.;
  15660. * TAB1.LIG1 = TAB1.L_BAS ;
  15661. * TAB1.TINI = 150. ;
  15662. *JS 19/10/94 je ne vois pas a quoi sert .TINI
  15663. * TAB1.TINI = 0. ;
  15664. * CHAI = CHAR (TAB1 .CHARMECAFI) ( EVOL MANU LIS1 XF1 ) ;
  15665. MESS '>>>>>>>>DEBUT RIGIDITE ' ;
  15666. RIG10 = RIG_1 et ( TAB1 . BLOCAGE ) ;
  15667. * CHAI = CHAR (TAB1 .CHARMECAFI) ( EVOL MANU LIS1 XF1 ) ;
  15668. MESS '>>>>>>>>APPEL a NONLIN' ;
  15669. NONLIN RIG10 MAT_1 CHARG1 LIS1 MOD_1 TAB1 ;
  15670. FINSI ;
  15671. MESS '---------------------------------> sortie de MECASCH1';
  15672. FINPROC ;
  15673.  
  15674. *-----------------------------------------------------------------------
  15675. *
  15676. *----------Fin de la procedure MECASCH1
  15677. *
  15678. *----------Debut de la procedure MECASCH2
  15679. *
  15680. *-----------------------------------------------------------------------
  15681. *23456789012345678901234567890123456789012345678901234567890123456789012
  15682. * 1 2 3 4 5 6 7
  15683. ************************************************************************
  15684.  
  15685. 'DEBPROC' MECASCH2 TAB1*'TABLE ' ;
  15686.  
  15687. MESS '---------------------------------> entree dans MECASCH2';
  15688. SI ( NON (EXISTE TAB1 LM_SIGCOMP )) ;
  15689. TAB1.LM_SIGCOMP = MOTS 'VONM' ;
  15690. FINSI ;
  15691. SI ( NON (EXISTE TAB1 L_CASADEPOU )) ;
  15692. TAB1.L_CASADEPOU = PROG (EXTR (DIME LIS1) LIS1) ;
  15693. FINSI ;
  15694. V1 = VALEUR 'DIME' ;
  15695. SI ( NON (EXISTE TAB1 VIEW_P )) ;
  15696. TAB1.VIEW_P = TEXT ' ' ;
  15697. SI ( EGA ( VALE DIME) 3 ) ;
  15698. TAB1.VIEW_P = 1.E8 1.E8 1.E8 ;
  15699. FINSI ;
  15700. FINSI ;
  15701.  
  15702. SI ( V1 EGA 2) ;
  15703. TFRONT1 = TEXT ' CONTOUR' ;
  15704. * modif mitteau
  15705. * TCACH = TEXT ' ' ;
  15706. TCACH = ' ' ;
  15707. SINON ;
  15708. TFRONT1 = TEXT ' ENVELOP' ;
  15709. TCACH = ' CACH ' ;
  15710. * TCACH = TEXT ' CACH ' ;
  15711. FINSI ;
  15712.  
  15713. IPP1 = 0 ;
  15714. REPETER BOMA10 ;
  15715. IPP1 = IPP1 + 1 ;
  15716. SI ( EXISTE (TAB1.ZONE_MAT) IPP1 ) ;
  15717. SI ( IPP1 EGA 1 ) ;
  15718. STOT1 = TAB1.ZONE_MAT . IPP1 ;
  15719. CONTT1 = TFRONT1 (TAB1.ZONE_MAT . IPP1 ) ;
  15720. MOD_T1 = TAB1.MODL_MAT. IPP1 ;
  15721. SINON ;
  15722. STOT1 = STOT1 ET (TAB1.ZONE_MAT . IPP1) ;
  15723. CONTT1 = CONTT1 ET ( TFRONT1 (TAB1.ZONE_MAT. IPP1)) ;
  15724. MOD_T1 = MOD_T1 ET TAB1.MODL_MAT. IPP1 ;
  15725. FINSI ;
  15726. SINON ;
  15727. QUITTER BOMA10 ;
  15728. FINSI ;
  15729. FIN BOMA10 ;
  15730.  
  15731. TAB1.L_CONTOUR = CONTT1 ;
  15732. TAB1.S_TOTAL = STOT1 ;
  15733.  
  15734. SI ( NON (EXISTE TAB1 S_ADEPOU )) ;
  15735. CONTT1 = TAB1.L_CONTOUR ;
  15736. STOT1 = TAB1.S_TOTAL ;
  15737. MOTOT1 = MOD_T1 ;
  15738. SINON ;
  15739. STOT1 = TAB1.S_ADEPOU ;
  15740. MOTOT1 = TAB1.MO_ADEPOU ;
  15741. SI ( NON (EXISTE TAB1 C_ADEPOU )) ;
  15742. CONTT1 = TFRONT1 TAB1.S_ADEPOU ;
  15743. SINON ;
  15744. CONTT1 = TAB1.C_ADEPOU ;
  15745. FINSI ;
  15746. FINSI ;
  15747.  
  15748. TAC8 = TABLE ;
  15749. TAC8.1 = 'NOLI ' ;
  15750. TAC8.2 = 'MARQ PLUS REGU' ;
  15751. TAC8.3 = 'MARQ ETOI REGU' ;
  15752. TAC8.4 = 'MARQ LOSA REGU' ;
  15753. TAC8.5 = 'MARQ CARR REGU' ;
  15754. TAC8.6 = 'MARQ TRIA REGU' ;
  15755. TAC8.7 = 'MARQ TRIB REGU' ;
  15756. TAC8.8 = 'MARQ PLUS REGU' ;
  15757. TAC8.9 = 'MARQ ETOI REGU' ;
  15758. TAC8.10 = 'MARQ CROI REGU' ;
  15759.  
  15760. SI ( NON (EXISTE TAB1 LM_SIGCOMP )) ;
  15761. TAB1.LM_SIGCOMP = MOTS 'VONM' ;
  15762. FINSI ;
  15763.  
  15764. SI ( NON (EXISTE TAB1 L_CASADEPOU )) ;
  15765. TAB2 = INDE TAB1.RESUDEPL ;
  15766. MESS '>>>>>>ESSAI DIME DE TAB2' ( DIME TAB2 ) ;
  15767. I1 = 0 ;
  15768.  
  15769. REPETER BINDE1 ;
  15770. I1 = I1 + 1 ;
  15771. SI (EXISTE TAB2 I1 ) ;
  15772. XX2 = TAB2.I1 ;
  15773. SINON ;
  15774. QUITTER BINDE1 ;
  15775. FINSI ;
  15776. FIN BINDE1 ;
  15777.  
  15778. TAB1.L_CASADEPOU = PROG XX2 ;
  15779. FINSI ;
  15780.  
  15781. TCACH = TEXT ' ' ;
  15782. SI ( EGA ( VALE DIME) 3 ) ;
  15783. TCACH = TEXT ' CACH ' ;
  15784. FINSI ;
  15785.  
  15786. MOD_1 = TAB1.MODTOT ;
  15787. MAT_1 = TAB1.MATTOT ;
  15788. *
  15789. *JS 10/94 introduction option TAB1.TRAC_DEFOCONT
  15790. SI( NON ( EXISTE TAB1 TRAC_DEFOCONT )) ;
  15791. TAB1.TRAC_DEFOCONT = VRAI ;
  15792. FINSI ;
  15793. SI TAB1.TRAC_DEFOCONT ;
  15794. MONMAIL = CONTT1 ;
  15795. SINON ;
  15796. MONMAIL = STOT1 ;
  15797. FINSI ;
  15798. SI ( (TAB1.PLASTIQUE ) ET ( NON TAB1.DEFO_PLANE_GENE )) ;
  15799. MESS '>>>>>>> 3.1.0 >>>>>>' ;
  15800. I1 = 0 ;
  15801. REPETER BDEPO1 ( DIME TAB1.L_CASADEPOU ) ;
  15802. I1 = I1 + 1 ;
  15803. XIT1 = EXTR I1 TAB1.L_CASADEPOU ;
  15804. VMI1 = VMIS MOD_1 TAB1.RESUCONT.XIT1 ;
  15805. SIRESU1 = ET TAB1.RESUCONT.XIT1 VMI1 ;
  15806. SIRESUA = ET TAB1.RESUVARI.XIT1 VMI1 ;
  15807.  
  15808. DEF0 = DEFO MONMAIL TAB1.RESUDEPL.XIT1 0. ;
  15809. DEF5 = DEFO MONMAIL TAB1.RESUDEPL.XIT1 20. ROUGE ;
  15810. TITRE 'TIME' XIT1 ' structure temperature' ;
  15811. MESS '>>>>>>> 3.1.1 >>>>>>' ;
  15812. TMMM1 = MAXI (TAB1.'CHPOTHETA'.XIT1) ;
  15813. TMMI1 = MINI (TAB1.'CHPOTHETA'.XIT1) ;
  15814. DTMI1 = ABS (TMMM1 - TMMI1) ;
  15815.  
  15816. SI (EXISTE TAB1 TRAC_THERM) ;
  15817. SI (TAB1.TRAC_THERM EGA VRAI ) ;
  15818. SI( DTMI1 >EG 0.005 ) ;
  15819. * modif raph
  15820. * MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 TAB1.'CHPOTHETA'.XIT1;
  15821. * TRAC TCACH TAB1.VIEW_P MC_CHAM MC_MODL MC_MAIL CONTT1;
  15822. * SI ( EXISTE TAB1 VIEW_P2 ) ;
  15823. * MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 TAB1.'CHPOTHETA'.XIT1;
  15824. * TRAC TCACH TAB1.VIEW_P2 MC_CHAM MC_MODL MC_MAIL CONTT1;
  15825. * FINSI ;
  15826. TRAC TCACH TAB1.VIEW_P TAB1.'CHPOTHETA'.XIT1 CONTT1 ;
  15827. SI ( EXISTE TAB1 VIEW_P2 ) ;
  15828. TRAC TCACH TAB1.VIEW_P2 TAB1.'CHPOTHETA'.XIT1 CONTT1;
  15829. FINSI ;
  15830.  
  15831. FINSI ;
  15832. FINSI ;
  15833. FINSI ;
  15834.  
  15835. TITRE 'TIME' XIT1 ' structure deformation' ;
  15836. MESS '>>>>>>> 3.1.3 >>>>>>' ;
  15837. * TRAC TCACH TAB1.VIEW_P (ET DEF0 DEF5 ) ;
  15838. TRAC CACH TAB1.VIEW_P (ET DEF0 DEF5 ) ;
  15839. SI ( EXISTE TAB1 VIEW_P2 ) ;
  15840. * TRAC TCACH TAB1.VIEW_P2 ( ET DEF0 DEF5 ) ;
  15841. TRAC CACH TAB1.VIEW_P2 ( ET DEF0 DEF5 ) ;
  15842. FINSI ;
  15843.  
  15844. I2 = 0 ;
  15845. REPETER BDEPO2 ( DIME TAB1.LM_SIGCOMP) ;
  15846. I2 = I2 + 1 ;
  15847. MOCOMP = EXTR TAB1.LM_SIGCOMP I2 ;
  15848. TITRE 'TIME' XIT1 MOCOMP ' STRESSES' ;
  15849. SI (( EGA MOCOMP 'VMIS') OU ( EGA MOCOMP 'VONM') );
  15850. MOCOMP = 'SCAL' ;
  15851. * SINON ;
  15852. * MC_CHAM MC_MODL MC_MAIL =
  15853. * @CHAQT MOTOT1 ( EXCO SIRESUA MOCOMP );
  15854. * TRAC CACH TAB1.VIEW_P MOD_1
  15855. * MC_CHAM MC_MODL MC_MAIL CONTT1 ;
  15856. FINSI ;
  15857.  
  15858. MESS '>>>>>>> 3.1.4 >>>>>>' ;
  15859. CHCONT1 = (REDU (EXCO SIRESU1 MOCOMP) MOTOT1) ;
  15860.  
  15861. SI ( EGA (MAXI CHCONT1) (MINI CHCONT1) 1.0E-19) ;
  15862. MESS 'Champs constant => on donne la valeur ' ;
  15863. LIST MOCOMP ;
  15864. LIST (MAXI CHCONT1) ;
  15865. SINON ;
  15866. MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 CHCONT1 ;
  15867. @TRASCH TCACH TAB1.VIEW_P MC_CHAM MC_MODL MC_MAIL STOT1 CONTT1 ;
  15868. FINSI ;
  15869.  
  15870. SI ( EXISTE TAB1 VIEW_P2 ) ;
  15871. SI (EGA (MAXI CHCONT1) (MINI CHCONT1) 1.0E-19) ;
  15872. MESS 'Champs constant => on donne la valeur ' ;
  15873. LIST MOCOMP ;
  15874. LIST (MAXI CHCONT1) ;
  15875. SINON ;
  15876. MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 CHCONT1 ;
  15877. @TRASCH TCACH TAB1.VIEW_P2 MC_CHAM MC_MODL MC_MAIL STOT1 CONTT1 ;
  15878. FINSI ;
  15879. FINSI ;
  15880.  
  15881. FIN BDEPO2 ;
  15882. FIN BDEPO1 ;
  15883. I3 = 0 ;
  15884. REPETER BDEPO3 ( DIME TAB1.L_CASADEPOU ) ;
  15885. I3 = I3 + 1 ;
  15886. XIT1 = EXTR I3 TAB1.L_CASADEPOU ;
  15887. DEPL_1 = TAB1.RESUDEPL.XIT1 ;
  15888. SI_1 = TAB1.RESUCONT.XIT1 ;
  15889. * EPS_2 = TAB1.RESUDEFI.XIT1 + (ELAS MOD_1 SI_1 MAT_1) ;
  15890. * MOD_1 = TAB1.MODTOT ;
  15891. EPS_1 = EPSI MOD_1 DEPL_1 ;
  15892. EPS_1 = EPS_1 ET ( EXCO EPSE TAB1.RESUVARI.XIT1) ;
  15893. I4 = 0 ;
  15894. REPETER BDEPO4 ( DIME TAB1.LM_EPSCOMP) ;
  15895. I4 = I4 + 1 ;
  15896. MOCOMP = EXTR TAB1.LM_EPSCOMP I4 ;
  15897. TITRE 'TIME' XIT1 MOCOMP ' STRAINS' ;
  15898. SI ( EGA MOCOMP 'EPSE') ;
  15899. TITRE 'TIME' XIT1 ' EPSE PLASTIC EQUIVALENT STRAINS ';
  15900.  
  15901. * SINON ;
  15902. * MC_CHAM MC_MODL MC_MAIL =
  15903. * @CHAQT MOTOT1 ( EXCO EPS_2 MOCOMP );
  15904. * TRAC CACH TAB1.VIEW_P MOD_1 MC_CHAM MC_MODL MC_MAIL
  15905. * CONTT1;
  15906.  
  15907. FINSI ;
  15908.  
  15909. SI (( EGA MOCOMP 'EPZZ') ET ( V1 EGA 2 )) ;
  15910. EPS_3 = TAB1.RESUDEFI.XIT1 + (EPSCHL MOD_1 SI_1 (TAB1.CHPOTHETA. 0.) (TAB1.CHPOTHETA.XIT1) TAB1 );
  15911. TITRE 'TIME' XIT1 MOCOMP ' STRAINS' ;
  15912. MESS '>>>>>>> 3.1.5 >>>>>>' ;
  15913. MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 ( REDU ( EXCO EPS_3 MOCOMP ) MOTOT1 );
  15914. @TRASCH TCACH TAB1.VIEW_P MC_CHAM MC_MODL MC_MAIL STOT1 CONTT1 ;
  15915. SI ( EXISTE TAB1 VIEW_P2 );
  15916. MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 ( REDU ( EXCO EPS_3 MOCOMP ) MOTOT1 );
  15917. @TRASCH TCACH TAB1.VIEW_P2 MC_CHAM MC_MODL MC_MAIL STOT1 CONTT1;
  15918. FINSI ;
  15919. SINON ;
  15920. MESS '>>>>>>> 3.1.6 >>>>>>' ;
  15921. SI ( EGA (MAXI ( ( REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 ))) (MINI ( ( REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 ))) 1.0E-19) ;
  15922. MESS 'Champs constant => on donne la valeur ' ;
  15923. LIST MOCOMP ;
  15924. LIST (MAXI ( ( REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 )));
  15925. SINON ;
  15926. MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 ( REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 );
  15927. @TRASCH TCACH TAB1.VIEW_P MC_CHAM MC_MODL MC_MAIL STOT1 CONTT1 ;
  15928. FINSI ;
  15929. SI ( EXISTE TAB1 VIEW_P2 ) ;
  15930. SI ( EGA (MAXI (REDU ( EXCO EPS_1 MOCOMP ) MOTOT1)) (MINI (REDU ( EXCO EPS_1 MOCOMP ) MOTOT1)) 1.0E-19) ;
  15931. MESS 'Champs constant => on donne la valeur ' ;
  15932. LIST MOCOMP ;
  15933. LIST (MAXI ( ( REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 ))) ;
  15934. SINON ;
  15935. MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 ( REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 ) ;
  15936. @TRASCH TCACH TAB1.VIEW_P2 MC_CHAM MC_MODL MC_MAIL STOT1 CONTT1;
  15937. FINSI ;
  15938. FINSI ;
  15939. FINSI ;
  15940. FIN BDEPO4 ;
  15941. FIN BDEPO3 ;
  15942. * DEPOMIMA TAB1 ;
  15943. FINSI ;
  15944. MESS '---------------------------------> sortie de MECASH2';
  15945. FINPROC ;
  15946. **** @OMBJET
  15947.  
  15948. DEBPROC @OMBJET TAB1*TABLE ;
  15949. *
  15950. ***************************************************
  15951. * PROGRAMME CASTEM GERANT L'APPEL AUX DIFFERENTES *
  15952. * PROCEDURES POUR REMONTER LES LIGNES DE CHAMP *
  15953. * SELON LA METHODE CHOISIE. *
  15954. * (VERSION DE @OMBRAGE POUR JET) *
  15955. ***************************************************
  15956. * Modif : *
  15957. * 09/11/01 (A.MOAL) : sens de remontee selon le *
  15958. * signe de dpsi *
  15959. * 23/11/01 (A.MOAL) : suppression du sens de *
  15960. * remontee suivant le signe *
  15961. * de dpsi *
  15962. * 23/11/01 (A.MOAL) : possibilite d'imposer le *
  15963. * sens de remontee *
  15964. ***************************************************
  15965. *
  15966. MESS '---------------------------------> calling @OMBJET';
  15967.  
  15968. *--- VARIABLES D'ENTREE :
  15969.  
  15970. MAIL1 = TAB1.<S_OMBRE ;
  15971. VMAIL1 = TAB1.<V_OMBRE_N;
  15972. GMAIL1 = TAB1.<S_OMBRE_N;
  15973.  
  15974. MAIL2 = TAB1.<S_OMBRANT ;
  15975. VMAIL2 = TAB1.<V_OMBRANT_N;
  15976. GMAIL2 = TAB1.<S_OMBRANT_N;
  15977. IMETHOD = TAB1.<METHODE_REMONTEE ;
  15978.  
  15979. SI (EXIS TAB1 <SAUV_PTS_OMBRANTS ) ;
  15980. REPO = TAB1.<SAUV_PTS_OMBRANTS ;
  15981. SINON ;
  15982. REPO = FAUX ;
  15983. FINSI ;
  15984.  
  15985. si (non (exis tab1 <reprise)) ;
  15986. tab1.<reprise = faux ;
  15987. finsi ;
  15988.  
  15989. * --- distance de remontee precedente en cas de reprise
  15990. si (tab1.<reprise) ;
  15991. d_prec = tab1.<LONGUEUR_REMONTEE ;
  15992. sinon ;
  15993. d_prec = 0. ;
  15994. finsi ;
  15995.  
  15996. DMAX2 = TAB1.<DIST_AVEC_TEST ;
  15997. PASB2 = TAB1.<PAS_AVEC_TEST ;
  15998.  
  15999. REPV = EXIS TAB1 <DIST_SANS_TEST ;
  16000. SI REPV ;
  16001. DMAX1 = TAB1.<DIST_SANS_TEST ;
  16002. PASB1 = TAB1.<PAS_SANS_TEST ;
  16003. FINSI ;
  16004. *
  16005. * --- Si le calcul est une reprise, on ne re-calcule pas CHSIGN1
  16006. *
  16007. si (non (tab1.<reprise));
  16008. * --- VARIABLES D'ENTREE, Valeurs par defaut
  16009. *
  16010. @VDEFJET TAB1 ;
  16011.  
  16012. SENS0 = TAB1.<SENS_REMONTEE ;
  16013. *
  16014. * ----
  16015. MESS '>@OMBJET> Construction du champoint B scalaire N';
  16016. *
  16017. *---- lecture de la carte de champ magnetique dans un fichier
  16018. @LECTB TAB1 ;
  16019. TITRE '@OMBJET : MAGNETIC DOMAIN, STUDIED AND SHADING OBJECT';
  16020. *TRAC (TAB1.<GRILLE_B ET MAIL2 ET MAIL1) ;
  16021. TRAC ((ENVE TAB1.<GRILLE_B) ET (ENVE MAIL2) ET (ENVE MAIL1)) ;
  16022.  
  16023. * ---- Calcul du champ dans le repere global
  16024.  
  16025. * ---- coordonnees dans le repere du maillage
  16026. XM0 = COOR 1 GMAIL1 ;
  16027. YM0 = COOR 2 GMAIL1 ;
  16028. DIM0 = VALEUR DIME ;
  16029. SI (DIM0 EGA 2) ;
  16030. ZM0 = XM0 * 0. ;
  16031. BNUL = XM0 * 0. ;
  16032. SINON ;
  16033. ZM0 = COOR 3 GMAIL1 ;
  16034. FINSI ;
  16035.  
  16036. *---- Coordonnees dans le repere global du
  16037. *---- tore (pas de changement de repere)
  16038. XG_OLD = XM0 ;
  16039. YG_OLD = YM0 ;
  16040. ZG_OLD = ZM0 ;
  16041.  
  16042. TAB1.<MAILLAGE_B = MAIL1 ;
  16043. BR BZ BPHI = @MAGNB TAB1 ;
  16044.  
  16045. *---- composantes de B dans le repere du maillage
  16046. PHI = ATG (COOR 2 MAIL1) (COOR 1 MAIL1) ;
  16047. *AM*11/09/01*BX = BR * (COS PHI) + (BPHI * (SIN PHI));
  16048. *AM*11/09/01*BY = BR * (SIN PHI) - (BPHI * (COS PHI));
  16049. BXM = BR * (COS PHI) - (BPHI * (SIN PHI));
  16050. BYM = BR * (SIN PHI) + (BPHI * (COS PHI));
  16051. BZM = BZ ;
  16052. MENAGE ;
  16053. *
  16054. *---- calcul des normales a la surface calculees
  16055. *---- dans le repere du maillage
  16056. si ((non (exis tab1 <nxm)) et ((nbno GMAIL1) ega (nbno MAIL1)));
  16057. MESS 'APPEL DE VNORM3D POUR LE MAILLAGE OMBRE';
  16058. NXM NYM NZM = @VNORM3D VMAIL1 GMAIL1 ;
  16059. tab1.<nxm = NXM ;
  16060. tab1.<nym = NYM ;
  16061. tab1.<nzm = NZM ;
  16062. sinon ;
  16063. NXM = tab1.<nxm ;
  16064. NYM = tab1.<nym ;
  16065. NZM = tab1.<nzm ;
  16066. finsi ;
  16067.  
  16068. *---- calcul du produit scalaire
  16069. PVBVN = (BXM*NXM) + (BYM*NYM) + (BZM*NZM);
  16070. CHSIGN0 = PVBVN / (ABS PVBVN) ;
  16071.  
  16072. SI (SENS0 NEG 0) ;
  16073. * ---- possibilite d'imposer le sens de remontee des lignes
  16074. * ---- sans tenir compte du critere sur b.n
  16075. CHSIGN0 = (ABS CHSIGN0) * SENS0 ;
  16076. FINSI ;
  16077.  
  16078. *---- debut modif (09/11/01 - A.Moal)
  16079. *---- mise en commentaire des modifs le 23/11/01 - A.Moal
  16080. * l'idee abandonnee \E9tait :
  16081. * Si SENS0 = 0 alors on remonte les lignes de champ avec
  16082. * pour seul critere le sens de la normale sortante.
  16083. * Si SENS0 = 1, on remonte dans le sens de B lorsque dpsi
  16084. * est positif et dans le sens de -B lorsque dpsi est
  16085. * negatif \E0 condition que ce soit dans le sens de
  16086. * la normale sortante (sinon la ligne n'est pas
  16087. * remontee pour le point considere).
  16088. * Si SENS0 = - 1, on remonte dans le sens de B lorsque
  16089. * dpsi est negatif et dans le sens de -B lorsque
  16090. * dpsi est positif \E0 condition que ce soit dans le
  16091. * sens de la normale sortante (sinon la ligne n'est
  16092. * pas remontee pour le point considere).
  16093. *SI (SENS0 NEG 0) ;
  16094. * ---- on definit un sens de remontee en fonction de dpsi
  16095. * CHDPSI = @DPSI TAB1 ;
  16096. * SIGDPSI = CHDPSI * SENS0 / (ABS CHDPSI) ;
  16097. * TITRE '@OMBJET : DPSI ON THE SHADOWED MESH' ;
  16098. * TRAC CHDPSI MAIL1 ;
  16099. * TITRE '@OMBJET : SIGN OF DPSI ON THE SHADOWED MESH' ;
  16100. * TRAC SIGDPSI MAIL1 ;
  16101. * ----- on ne remonte que les points dont le sens de remontee
  16102. * ----- impose par <SENS_REMONTEE est le meme qu'avec le critere de
  16103. * ----- la normale sortante (CHSIGN0 = 0. pour les autres points)
  16104. * CHSIGN0 = CHSIGN0 * ((CHSIGN0 * SIGDPSI) MASQUE SUPERIEUR 0.);
  16105. *FINSI ;
  16106. *VB1 = @CVECT (BXM*CHSIGN0) (BYM*CHSIGN0) (BZM*CHSIGN0)
  16107. * TAB1.LFLUX_EXTE VERT;
  16108. *TITRE '@OMBJET : DIRECTION FOR COMING UP THE MAGNETIC LINES' ;
  16109. *TRAC VB1 MAIL1 ;
  16110. *---- fin mise en commentaire
  16111. *---- fin modif
  16112.  
  16113. *---- PROJECTION SUR LE MAILLAGE FIN INITIAL
  16114. *---- BOUCLE SUR CHAQUE POINT DU MAILLAGE FIN
  16115. MAILPT = CHAN MAIL1 POI1 ;
  16116. NBNFIN = NBNO MAIL1 ;
  16117. PT1 = ELEM MAILPT POINT 1 ;
  16118. PP = GMAIL1 POIN PROC PT1 ;
  16119. VAL1 = EXTR CHSIGN0 SCAL PP ;
  16120. MAILP1 = MANU POI1 PT1 ;
  16121. CHSIGN1 = MANU CHPO MAILP1 1 SCAL VAL1 'NATURE' DIFFUS ;
  16122. REPETER BOUPI (NBNFIN - 1) ;
  16123. I = &BOUPI + 1 ;
  16124. PTI = ELEM MAILPT POINT I ;
  16125. PPI = GMAIL1 POIN PROC PTI ;
  16126. VALI = EXTR CHSIGN0 SCAL PPI ;
  16127. MAILPI = MANU POI1 PTI ;
  16128. CHI = MANU CHPO MAILPI 1 SCAL VALI 'NATURE' DIFFUS ;
  16129. CHSIGN1 = CHSIGN1 ET CHI ;
  16130. FIN BOUPI ;
  16131.  
  16132. *---- Complement de TAB1.<CHSIGN1 sur les noeuds dont on veut remonter
  16133. *---- les lignes de champ
  16134. si (exis tab1 <remontee) ;
  16135. NPTS = DIME tab1 . <remontee . <point ;
  16136. REPETER BOUPTS1 NPTS ;
  16137. pt1 = tab1 . <remontee . <point . &BOUPTS1 ;
  16138. PP1 = MAIL1 POIN PROC PT1 ;
  16139. MAILP1 = MANU POI1 PT1 ;
  16140. VAL1 = EXTR CHSIGN1 SCAL PP1 ;
  16141. CH1 = MANU CHPO MAILP1 1 SCAL VAL1 'NATURE' DIFFUS ;
  16142. CHSIGN1 = CHSIGN1 ET CH1 ;
  16143. FIN BOUPTS1 ;
  16144. finsi ;
  16145.  
  16146. TAB1.<CHSIGN = CHSIGN1 ;
  16147. finsi ;
  16148.  
  16149. * === NOMBRE DE PAS MAXIMUM A EFFECTUER PAR LA PROCEDURE
  16150. * RM310898 ruse pour ne pas avoir de pb avec les parties entieres
  16151. * apres constat comportement erratique
  16152.  
  16153. nbpas2 = ENTIER ((DMAX2 + (PASB2/1000.))/PASB2) ;
  16154. TAB1.<NBPAS2 = NBPAS2 ;
  16155. DMAX0 = (NBPAS2 * PASB2) + d_prec ;
  16156.  
  16157. si (exis tab1 <DIST_SANS_TEST) ;
  16158. nbpas1 = ENTIER ((DMAX1 + (PASB1/1000.))/PASB1) ;
  16159. TAB1.<NBPAS1 = NBPAS1 ;
  16160. DMAX0 = (NBPAS1 * PASB1) + (NBPAS2 * PASB2) + d_prec ;
  16161. finsi ;
  16162.  
  16163. *
  16164. * --- Choix du test d'intersection ANALYTIQUE (par defaut) ou GEOMETRIQUE
  16165. *
  16166. SI (NON (EXIS TAB1 <METHODE_INTERSECTION)) ;
  16167. TAB1.<METHODE_INTERSECTION = ANALYTIQUE ;
  16168. FINSI ;
  16169.  
  16170. *
  16171. * --- Appel de la procedure utiliant la methode analytique
  16172. *
  16173. SI (EGA TAB1.<METHODE_INTERSECTION ANALYTIQUE) ;
  16174. @ANAJET TAB1 ;
  16175. * ---- on retrouve la forme initiale
  16176. FORM (TAB1.<DEPLACE * (-1.)) ;
  16177. FINSI ;
  16178. *
  16179.  
  16180.  
  16181. * --- Appel de la procedure utiliant la methode geometrique
  16182. *
  16183. SI (EGA TAB1.<METHODE_INTERSECTION GEOMETRIQUE) ;
  16184. CHDIST0 MAI1TRAV POMB = @TESTGEO TAB1 ;
  16185. TAB1.<CHDIST = CHDIST0;
  16186. TAB1.<MAI1TRAV = MAI1TRAV ;
  16187. FINSI ;
  16188.  
  16189. MESS '>@OMBJET> - execution correcte' ;
  16190. MESS '>@OMBJET> remontee en metre :' TAB1.<LONGUEUR_REMONTEE ;
  16191.  
  16192. SI (EGA (TAB1.<CONNEXION_MAX) 0.) ;
  16193. MESS ' ' ;
  16194. MESS '>@OMBJET> Pas d ombrage de OMBRE par OMBRANT';
  16195. MESS ' ' ;
  16196. SINON;
  16197. MESS '>@OMBJET> mini - maxi de la longueur de connection' (mini TAB1.<CHDIST) TAB1.<CONNEXION_MAX ;
  16198. FINSI;
  16199.  
  16200. SI REPO ;
  16201. TAB1.<P_OMBRANTS = POMB ;
  16202. FINSI ;
  16203. * --------------- VARIABLES DE SORTIE GENERALES :
  16204. TAB1.<MASQOMB = MASQ TAB1.<CHDIST EGSUPE (DMAX0 - (PASB2/1000.)) ;
  16205. *------------------------------------
  16206.  
  16207. *
  16208. MESS '---------------------------------> exiting @OMBJET';
  16209. FINPROC ;
  16210. **** @OMBRAGE
  16211. DEBPROC @OMBRAGE TAB1*TABLE ;
  16212. *
  16213. ***************************************************
  16214. * PROGRAMME CASTEM GERANT L'APPEL AUX DIFFERENTES *
  16215. * PROCEDURES POUR REMONTER LES LIGNES DE CHAMP *
  16216. * SELON LA METHODE CHOISIE *
  16217. ***************************************************
  16218. *
  16219. MESS '---------------------------------> calling @OMBRAGE';
  16220.  
  16221. *--- VARIABLES D'ENTREE :
  16222.  
  16223. MAIL1 = TAB1.<S_OMBRE ;
  16224. VMAIL1 = TAB1.<V_OMBRE_N;
  16225. GMAIL1 = TAB1.<S_OMBRE_N;
  16226.  
  16227. MAIL2 = TAB1.<S_OMBRANT ;
  16228. VMAIL2 = TAB1.<V_OMBRANT_N;
  16229. GMAIL2 = TAB1.<S_OMBRANT_N;
  16230. IMETHOD = TAB1.<METHODE_REMONTEE ;
  16231.  
  16232. RP = TAB1.<RP ;
  16233. HP = TAB1.<HP ;
  16234.  
  16235. SI (EXIS TAB1 <SAUV_PTS_OMBRANTS ) ;
  16236. REPO = TAB1.<SAUV_PTS_OMBRANTS ;
  16237. SINON ;
  16238. REPO = FAUX ;
  16239. FINSI ;
  16240.  
  16241. si (non (exis tab1 <reprise)) ;
  16242. tab1.<reprise = faux ;
  16243. finsi ;
  16244.  
  16245.  
  16246. * forcage du sens de remontee des linges de champ
  16247. * voir commentaire plus loin ou la notice
  16248. si (exis tab1 <chsignr1) ;
  16249. chsignr1 = tab1.<chsignr1 ;
  16250. finsi ;
  16251. *
  16252. * ------ verification de l'appartenance du maillage ombre ---------
  16253. * --------------- au domaine de validite de TOKAFLU ---------------
  16254. xm ym zm = coor mail1 ;
  16255. xg yg zg = @crmgc xm ym zm tab1 ;
  16256. rho theta phi = @crgtc xg yg zg rp hp ;
  16257. rhomax = maxi rho ;
  16258. rhomin = mini rho ;
  16259. thetamax = maxi theta ;
  16260. thetamin = mini theta ;
  16261. * RM 22/12/98 je desactive le test sur les angles
  16262. *si ((rhomax > 1.1) ou (rhomin < 0.4) ou
  16263. * (thetamax > 110.) ou (thetamin < -110.)) ;
  16264.  
  16265. si ((rhomax > 1.1) ou (rhomin < 0.4)) ;
  16266. ERRE ' >>>> @OMBRAGE : Le maillage ombre n est pas inclus dans le domaine de validite des modeles de @TOKAFLU';
  16267. finsi ;
  16268.  
  16269.  
  16270. * --- distance de remontee precedente en cas de reprise
  16271. si (tab1.<reprise) ;
  16272. d_prec = tab1.<LONGUEUR_REMONTEE ;
  16273. sinon ;
  16274. d_prec = 0. ;
  16275. finsi ;
  16276.  
  16277. DMAX2 = TAB1.<DIST_AVEC_TEST ;
  16278. PASB2 = TAB1.<PAS_AVEC_TEST ;
  16279.  
  16280. REPV = EXIS TAB1 <DIST_SANS_TEST ;
  16281. SI REPV ;
  16282. DMAX1 = TAB1.<DIST_SANS_TEST ;
  16283. PASB1 = TAB1.<PAS_SANS_TEST ;
  16284. FINSI ;
  16285. *
  16286. * --- Si le calcul est une reprise, on ne re-calcule pas CHSIGN1
  16287. *
  16288. si (non (tab1.<reprise));
  16289. * --- VARIABLES D'ENTREE, Valeurs par defaut
  16290. *
  16291. @VDEFAUT TAB1 ;
  16292. *
  16293. * ----
  16294. MESS '>@OMBRAGE> Construction du champoint B scalaire N';
  16295. *
  16296.  
  16297.  
  16298. * ---- Calcul du champ dans le repere global
  16299.  
  16300. * ---- coordonnees dans le repere du maillage
  16301. XM0 = COOR 1 GMAIL1 ;
  16302. YM0 = COOR 2 GMAIL1 ;
  16303. DIM0 = VALEUR DIME ;
  16304. SI (DIM0 EGA 2) ;
  16305. ZM0 = XM0 * 0. ;
  16306. BNUL = XM0 * 0. ;
  16307. SINON ;
  16308. ZM0 = COOR 3 GMAIL1 ;
  16309. FINSI ;
  16310.  
  16311.  
  16312. *---- Coordonnees dans le repere global du tore
  16313. XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
  16314.  
  16315.  
  16316. *
  16317. TYPCAL = TAB1.<TYPE_CALCUL ;
  16318. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  16319. ISHIFT = VRAI ;
  16320. IRIPPLE = VRAI ;
  16321. FINSI ;
  16322. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  16323. ISHIFT = VRAI ;
  16324. IRIPPLE = FAUX ;
  16325. FINSI ;
  16326. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  16327. ISHIFT = FAUX ;
  16328. IRIPPLE = VRAI ;
  16329. FINSI ;
  16330. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  16331. ISHIFT = FAUX ;
  16332. IRIPPLE = FAUX ;
  16333. FINSI ;
  16334. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  16335. ERRE '>@OMBRAGE> : check the value of TAB1.<TYPE_CALCUL';
  16336. FINSI ;
  16337.  
  16338.  
  16339. BXG BYG BZG FSECU = @CHAMB TAB1 XG_OLD YG_OLD ZG_OLD ISHIFT IRIPPLE ;
  16340. *---- composantes de B dans le repere du maillage
  16341. BXM BYM BZM = @CBGMV BXG BYG BZG TAB1 ;
  16342. *
  16343. *---- calcul des normales a la surface calculees
  16344. *---- dans le repere du maillage
  16345. si ((non (exis tab1 <nxm)) et ((nbno GMAIL1) ega (nbno MAIL1)));
  16346. MESS 'APPEL DE VNORM3D POUR LE MAILLAGE OMBRE';
  16347. NXM NYM NZM = @VNORM3D VMAIL1 GMAIL1 ;
  16348. tab1.<nxm = NXM ;
  16349. tab1.<nym = NYM ;
  16350. tab1.<nzm = NZM ;
  16351. sinon ;
  16352. NXM = tab1.<nxm ;
  16353. NYM = tab1.<nym ;
  16354. NZM = tab1.<nzm ;
  16355. finsi ;
  16356.  
  16357. *---- calcul du produit scalaire
  16358. PVBVN = (BXM*NXM) + (BYM*NYM) + (BZM*NZM);
  16359.  
  16360. CHSIGN0 = PVBVN / (ABS PVBVN) ;
  16361.  
  16362. *---- PROJECTION SUR LE MAILLAGE FIN INITIAL
  16363. *---- BOUCLE SUR CHAQUE POINT DU MAILLAGE FIN
  16364. MAILPT = CHAN MAIL1 POI1 ;
  16365. NBNFIN = NBNO MAIL1 ;
  16366. PT1 = ELEM MAILPT POINT 1 ;
  16367. PP = GMAIL1 POIN PROC PT1 ;
  16368. VAL1 = EXTR CHSIGN0 SCAL PP ;
  16369. MAILP1 = MANU POI1 PT1 ;
  16370. CHSIGN1 = MANU CHPO MAILP1 1 SCAL VAL1 'NATURE' DIFFUS ;
  16371. REPETER BOUPI (NBNFIN - 1) ;
  16372. I = &BOUPI + 1 ;
  16373. PTI = ELEM MAILPT POINT I ;
  16374. PPI = GMAIL1 POIN PROC PTI ;
  16375. VALI = EXTR CHSIGN0 SCAL PPI ;
  16376. MAILPI = MANU POI1 PTI ;
  16377. CHI = MANU CHPO MAILPI 1 SCAL VALI 'NATURE' DIFFUS ;
  16378. CHSIGN1 = CHSIGN1 ET CHI ;
  16379. FIN BOUPI ;
  16380.  
  16381. *---- Complement de TAB1.<CHSIGN1 sur les noeuds dont on veut remonter
  16382. *---- les lignes de champ
  16383. * ajout R. Mitteau le 13 mars 2001
  16384. * possibilite de definir soi-meme le chsign pour les noeuds
  16385. * dont on veut suivre la trajectoire
  16386. * on defini un tab1.chsign2, qu'on prend si il existe
  16387. si (exis tab1 <remontee) ;comm debut si sur point a remonter ;
  16388. si (exis tab1 <chsignr1) ;
  16389. chsign1 = chsign1 et chsignr1 ;
  16390. sinon ;
  16391. NPTS = DIME tab1 . <remontee . <point ;
  16392. REPETER BOUPTS1 NPTS ;
  16393. pt1 = tab1 . <remontee . <point . &BOUPTS1 ;
  16394. PP1 = MAIL1 POIN PROC PT1 ;
  16395. MAILP1 = MANU POI1 PT1 ;
  16396. VAL1 = EXTR CHSIGN1 SCAL PP1 ;
  16397. CH1 = MANU CHPO MAILP1 1 SCAL VAL1 'NATURE' DIFFUS ;
  16398. CHSIGN1 = CHSIGN1 ET CH1 ;
  16399. FIN BOUPTS1 ;
  16400. finsi ;
  16401. finsi ;comm fin si sur point a remonter ;
  16402. TAB1.<CHSIGN = CHSIGN1 ;
  16403. finsi ; comm refere au non tab1 reprise ;
  16404.  
  16405. * === NOMBRE DE PAS MAXIMUM A EFFECTUER PAR LA PROCEDURE
  16406. * RM310898 ruse pour ne pas avoir de pb avec les parties entieres
  16407. * apres constat comportement erratique
  16408.  
  16409. nbpas2 = ENTIER ((DMAX2 + (PASB2/1000.))/PASB2) ;
  16410. TAB1.<NBPAS2 = NBPAS2 ;
  16411. DMAX0 = (NBPAS2 * PASB2) + d_prec ;
  16412.  
  16413. si (exis tab1 <DIST_SANS_TEST) ;
  16414. nbpas1 = ENTIER ((DMAX1 + (PASB1/1000.))/PASB1) ;
  16415. TAB1.<NBPAS1 = NBPAS1 ;
  16416. DMAX0 = (NBPAS1 * PASB1) + (NBPAS2 * PASB2) + d_prec ;
  16417. finsi ;
  16418.  
  16419. *
  16420. * --- Choix du test d'intersection ANALYTIQUE (par defaut) ou GEOMETRIQUE
  16421. *
  16422. SI (NON (EXIS TAB1 <METHODE_INTERSECTION)) ;
  16423. TAB1.<METHODE_INTERSECTION = ANALYTIQUE ;
  16424. FINSI ;
  16425.  
  16426. *
  16427. * --- Appel de la procedure utiliant la methode analytique
  16428. *
  16429. SI (EGA TAB1.<METHODE_INTERSECTION ANALYTIQUE) ;
  16430. @ANALY TAB1 ;
  16431. FINSI ;
  16432. *
  16433.  
  16434.  
  16435. * --- Appel de la procedure utiliant la methode geometrique
  16436. *
  16437. SI (EGA TAB1.<METHODE_INTERSECTION GEOMETRIQUE) ;
  16438. CHDIST0 MAI1TRAV POMB = @TESTGEO TAB1 ;
  16439. TAB1.<CHDIST = CHDIST0;
  16440. TAB1.<MAI1TRAV = MAI1TRAV ;
  16441. FINSI ;
  16442.  
  16443. MESS '>@OMBRAG> - execution correcte' ;
  16444. MESS '>@OMBRAG> remontee en metre :' TAB1.<LONGUEUR_REMONTEE ;
  16445.  
  16446. SI (EGA (TAB1.<CONNEXION_MAX) 0.) ;
  16447. MESS ' ' ;
  16448. MESS '>@OMBRAGE> Pas d ombrage de OMBRE par OMBRANT';
  16449. MESS ' ' ;
  16450. SINON;
  16451. MESS '>@OMBRAG> mini - maxi de la longueur de connection' (mini TAB1.<CHDIST) TAB1.<CONNEXION_MAX ;
  16452. FINSI;
  16453.  
  16454. SI REPO ;
  16455. TAB1.<P_OMBRANTS = POMB ;
  16456. FINSI ;
  16457. * --------------- VARIABLES DE SORTIE GENERALES :
  16458. TAB1.<MASQOMB = MASQ TAB1.<CHDIST EGSUPE (DMAX0 - (PASB2/1000.)) ;
  16459. *------------------------------------
  16460.  
  16461. *
  16462. MESS '---------------------------------> exiting @OMBRAGE';
  16463. FINPROC ;
  16464. ***** OPIE
  16465. *********************************************************
  16466. ****** PROCEDURE IPOE ******
  16467. *********************************************************
  16468. * INTERPOLATION EN UTILISANT UNE EVOLUTION
  16469. *--------------------------------------------------------
  16470. DEBPROC OPIE OBJ_11/FLOTTANT OBJ_12/LISTREEL OBJ_13/CHPOINT EVO_1*EVOLUTION MO_1/MOT ;
  16471. *23456789012345678901234567890123456789012345678901234567890123456789012
  16472. * 1 2 3 4 5 6 7
  16473.  
  16474. LR_1 = EXTR EVO_1 'ABSC' 1 ;
  16475. LR_2 = EXTR EVO_1 'ORDO' 1 ;
  16476. IS1 = DIME LR_2 ;
  16477. LR_2B = ENLE LR_2 1 ;
  16478. LR_2A = ENLE LR_2 IS1 ;
  16479. IA1 = ( (LR_2B - LR_2A) MASQUE 'EGSUPE' 'SOMME' 0.) ;
  16480. II1 = ( (LR_2B - LR_2A) MASQUE 'EGINFE' 'SOMME' 0.) ;
  16481. IS2 = IS1 - 1 ;
  16482. SI ( IA1 EGA IS2 ) ;
  16483. LRE_2 = LR_1 ;
  16484. LRE_1 = LR_2 ;
  16485. A_1 = 1. ;
  16486. SINON ;
  16487. SI ( II1 EGA IS2 ) ;
  16488. A_1 = -1. ;
  16489. LRE_2 = LR_1 ;
  16490. LRE_1 = LR_2 * A_1 ;
  16491. SINON ;
  16492. MESS '>>>OPIE sorry your EVOL is not monotonous' ;
  16493. ERREUR '>>>OPIE sorry your EVOL is not monotonous' ;
  16494. FINSI ;
  16495. FINSI ;
  16496. SI ( NON (EXISTE MO_1)) ;
  16497. MO_2 = MOT 'SANS' ;
  16498. SINON ;
  16499. MO_2 = MO_1 ;
  16500. FINSI ;
  16501. SI (( EGA MO_2 'LINE' ) OU ( EGA MO_2 'FIXE' )) ;
  16502. SI ( EXISTE OBJ_11 ) ;
  16503. OBJ_2 = ITPLT LRE_1 LRE_2 MO_2 (OBJ_11 * A_1) ;
  16504. FINSI ;
  16505. SI ( EXISTE OBJ_12 ) ;
  16506. OBJ_2 = ITPLT LRE_1 LRE_2 MO_2 (OBJ_12 * A_1) ;
  16507. FINSI ;
  16508. SI ( EXISTE OBJ_13 ) ;
  16509. OBJ_2 = ITPLT LRE_1 LRE_2 MO_2 (OBJ_13 * A_1) ;
  16510. FINSI ;
  16511. SINON ;
  16512. SI ( EXISTE OBJ_11 ) ;
  16513. OBJ_2 = IPOL (OBJ_11 * A_1) LRE_1 LRE_2 ;
  16514. FINSI ;
  16515. SI ( EXISTE OBJ_12 ) ;
  16516. OBJ_2 = IPOL (OBJ_12 * A_1) LRE_1 LRE_2 ;
  16517. FINSI ;
  16518. SI ( EXISTE OBJ_13 ) ;
  16519. OBJ_2 = IPOL (OBJ_13 * A_1) LRE_1 LRE_2 ;
  16520. FINSI ;
  16521. FINSI ;
  16522. FINPROC OBJ_2 ;
  16523. *--------------------------------------------------------------------
  16524. **** ORTHO1
  16525. ********************
  16526. * PROCEDURE ORTHO1 *
  16527. ********************
  16528.  
  16529. DEBPROC ORTHO1 GEO1*MAILLAGE LIG1*MAILLAGE CH1*CHPOINT CH2*CHPOINT ALPHA*FLOTTANT LL*LISTREEL TYPEMAT*MOT TYPEELEM*LISTMOTS;
  16530.  
  16531. GEO = CHAN POI1 GEO1;
  16532. NEL1 = NBNO GEO;
  16533. DIMGEO = VALEUR DIME;
  16534. YOUNG11 = EXTR LL 1;
  16535. YOUNG22 = EXTR LL 2;
  16536. YOUNG33 = EXTR LL 3;
  16537. NU11 = EXTR LL 4;
  16538. NU22 = EXTR LL 5;
  16539. NU33 = EXTR LL 6;
  16540. CIS11 = EXTR LL 7;
  16541. CIS22 = EXTR LL 8;
  16542. CIS33 = EXTR LL 9;
  16543. ALPH11 = EXTR LL 10;
  16544. ALPH21 = EXTR LL 11;
  16545. ALPH31 = EXTR LL 12;
  16546. RHO = EXTR LL 13;
  16547.  
  16548. L1 = EXTR CH1 'COMP';
  16549. L2 = EXTR CH2 'COMP';
  16550.  
  16551. NBTYPE = DIME TYPEELEM;
  16552. NBCOMP = 0;
  16553. REPETER BOUCLNB NBTYPE;
  16554. NBCOMP = NBCOMP + 1;
  16555. TYPEN = EXTR TYPEELEM NBCOMP;
  16556. MODLNB = MODE GEO1 MECANIQUE ELASTIQUE ORTHOTROPE TYPEN ;
  16557. SI (NBCOMP EGA 1);
  16558. MODL1 = MODLNB;
  16559. SINON;
  16560. MODL1 = MODL1 ET MODLNB;
  16561. FINSI;
  16562. FIN BOUCLNB;
  16563.  
  16564. SI (DIMGEO EGA 3);
  16565. COMP = 0;
  16566. L11 = EXTR 1 L1;
  16567. L12 = EXTR 2 L1;
  16568. L13 = EXTR 3 L1;
  16569. L21 = EXTR 1 L2;
  16570. L22 = EXTR 2 L2;
  16571. L23 = EXTR 3 L2;
  16572. REPETER BOUCL1 NEL1;
  16573. COMP = COMP + 1;
  16574. POINMAIL = GEO POIN COMP;
  16575. POINCOUR = LIG1 POIN PROC POINMAIL;
  16576. CH1MAIL = MANU CHPO POINMAIL 3 KX (EXTR CH1 L11 POINCOUR) KY (EXTR CH1 L12 POINCOUR) KZ (EXTR CH1 L13 POINCOUR);
  16577. CH2MAIL = MANU CHPO POINMAIL 3 KX (EXTR CH2 L21 POINCOUR) KY (EXTR CH2 L22 POINCOUR) KZ (EXTR CH2 L23 POINCOUR);
  16578. SI (COMP EGA 1);
  16579. CH1GEO = CH1MAIL;
  16580. CH2GEO = CH2MAIL;
  16581. SINON;
  16582. CH1GEO = CH1GEO ET CH1MAIL;
  16583. CH2GEO = CH2GEO ET CH2MAIL;
  16584. FINSI;
  16585. FIN BOUCL1;
  16586.  
  16587. CH1 = ((COS ALPHA)*CH1GEO) + ((SIN ALPHA)*CH2GEO);
  16588. CH2 = (((-1.*(SIN ALPHA))*CH1GEO)) + ((COS ALPHA)*CH2GEO);
  16589.  
  16590. CHNEUTRE = (COOR 1 GEO1);
  16591. VRX = NOMC V1X (EXCO KX CH1);
  16592. VRY = NOMC V1Y (EXCO KY CH1);
  16593. VRZ = NOMC V1Z (EXCO KZ CH1);
  16594. VRX1 = CHAN CHAM VRX MODL1 RIGIDITE;
  16595. VRY1 = CHAN CHAM VRY MODL1 RIGIDITE;
  16596. VRZ1 = CHAN CHAM VRZ MODL1 RIGIDITE;
  16597. VZX = NOMC V2X (EXCO KX CH2);
  16598. VZY = NOMC V2Y (EXCO KY CH2);
  16599. VZZ = NOMC V2Z (EXCO KZ CH2);
  16600. VZX1 = CHAN CHAM VZX MODL1 RIGIDITE;
  16601. VZY1 = CHAN CHAM VZY MODL1 RIGIDITE;
  16602. VZZ1 = CHAN CHAM VZZ MODL1 RIGIDITE;
  16603. SINON;
  16604. COMP = 0;
  16605. L11 = EXTR 1 L1;
  16606. L12 = EXTR 2 L1;
  16607. L21 = EXTR 1 L2;
  16608. L22 = EXTR 2 L2;
  16609. REPETER BOUCL1 NEL1;
  16610. COMP = COMP + 1;
  16611. POINMAIL = GEO POIN COMP;
  16612. POINCOUR = LIG1 POIN PROC POINMAIL;
  16613. CH1MAIL = MANU CHPO POINMAIL 2 KX (EXTR CH1 L11 POINCOUR) KY (EXTR CH1 L12 POINCOUR);
  16614. CH2MAIL = MANU CHPO POINMAIL 2 KX (EXTR CH2 L21 POINCOUR) KY (EXTR CH2 L22 POINCOUR);
  16615. SI (COMP EGA 1);
  16616. CH1GEO = CH1MAIL;
  16617. CH2GEO = CH2MAIL;
  16618. SINON;
  16619. CH1GEO = CH1GEO ET CH1MAIL;
  16620. CH2GEO = CH2GEO ET CH2MAIL;
  16621. FINSI;
  16622. FIN BOUCL1;
  16623.  
  16624. CH1 = (CH1GEO*(COS ALPHA)) + (CH2GEO*(SIN ALPHA));
  16625. CH2 = ((CH1GEO*(-1.*(SIN ALPHA)))) + (CH2GEO*(COS ALPHA));
  16626.  
  16627. CHNEUTRE = (COOR 1 GEO1);
  16628. VRX = NOMC V1X (EXCO KX CH1);
  16629. VRY = NOMC V1Y (EXCO KY CH1);
  16630. VRX1 = CHAN CHAM VRX MODL1 RIGIDITE;
  16631. VRY1 = CHAN CHAM VRY MODL1 RIGIDITE;
  16632. VZX = NOMC V2X (EXCO KX CH2);
  16633. VZY = NOMC V2Y (EXCO KY CH2);
  16634. VZX1 = CHAN CHAM VZX MODL1 RIGIDITE;
  16635. VZY1 = CHAN CHAM VZY MODL1 RIGIDITE;
  16636.  
  16637. FINSI;
  16638.  
  16639. YOUNGR = ( CHNEUTRE * 0.) + YOUNG11;
  16640. YOUNGZ = ( CHNEUTRE * 0.) + YOUNG22;
  16641. YOUNGT = ( CHNEUTRE * 0.) + YOUNG33;
  16642. NURZ = ( CHNEUTRE * 0.) + NU11;
  16643. NUZT = ( CHNEUTRE * 0.) + NU22;
  16644. NURT = ( CHNEUTRE * 0.) + NU33;
  16645. CISRZ = ( CHNEUTRE * 0.) + CIS11;
  16646. CISZT = ( CHNEUTRE * 0.) + CIS22;
  16647. CISRT = ( CHNEUTRE * 0.) + CIS33;
  16648. ALPH12 = ( CHNEUTRE * 0.) + ALPH11;
  16649. ALPH22 = ( CHNEUTRE * 0.) + ALPH21;
  16650. ALPH32 = ( CHNEUTRE * 0.) + ALPH31;
  16651. RHO1 = ( CHNEUTRE * 0.) + RHO;
  16652.  
  16653. YOUNG1 = CHAN CHAM (NOMC YG1 YOUNGR) MODL1 RIGIDITE;
  16654. YOUNG2 = CHAN CHAM (NOMC YG2 YOUNGZ) MODL1 RIGIDITE;
  16655. YOUNG3 = CHAN CHAM (NOMC YG3 YOUNGT) MODL1 RIGIDITE;
  16656. NU1 = CHAN CHAM (NOMC NU12 NURZ) MODL1 RIGIDITE;
  16657. NU2 = CHAN CHAM (NOMC NU23 NUZT) MODL1 RIGIDITE;
  16658. NU3 = CHAN CHAM (NOMC NU13 NURT) MODL1 RIGIDITE;
  16659. CIS1 = CHAN CHAM (NOMC G12 CISRZ) MODL1 RIGIDITE;
  16660. CIS2 = CHAN CHAM (NOMC G23 CISZT) MODL1 RIGIDITE;
  16661. CIS3 = CHAN CHAM (NOMC G13 CISRT) MODL1 RIGIDITE;
  16662. ALPH1 = CHAN CHAM (NOMC ALP1 ALPH12) MODL1 RIGIDITE;
  16663. ALPH2 = CHAN CHAM (NOMC ALP2 ALPH22) MODL1 RIGIDITE;
  16664. ALPH3 = CHAN CHAM (NOMC ALP3 ALPH32) MODL1 RIGIDITE;
  16665. RHO = CHAN CHAM (NOMC 'RHO' RHO1) MODL1 RIGIDITE;
  16666.  
  16667. SI ((EGA TYPEMAT COMI) OU ( EGA TYPEMAT MABIPLAN));
  16668. MAT11 = YOUNG1 ET YOUNG2 ET NU1;
  16669. MAT22 = CIS1;
  16670. MAT33 = VRX1 et VRY1 et VZX1 et VZY1;
  16671. MAT44 = ALPH1 ET ALPH2 ET RHO;
  16672. FINSI;
  16673. SI ( EGA TYPEMAT COEP);
  16674. MAT11 = YOUNG1 ET YOUNG2 ET NU1;
  16675. MAT22 = CIS1 ET CIS2 ET CIS3;
  16676. MAT33 = VRX1 et VRY1 et VZX1 et VZY1;
  16677. MAT44 = ALPH1 ET ALPH2 ET RHO;
  16678. FINSI;
  16679. SI ( EGA TYPEMAT MABIAXI);
  16680. MAT11 = YOUNG1 ET YOUNG2 ET YOUNG3 ET NU1 ET NU2 ET NU3;
  16681. MAT22 = CIS1;
  16682. MAT33 = VRX1 et VRY1 et VRZ1 et VZX1 et VZY1 et VZZ1;
  16683. MAT44 = ALPH1 ET ALPH2 ET ALPH3 ET RHO;
  16684. FINSI ;
  16685. SI ( EGA TYPEMAT MABIFOU) ;
  16686. MAT11 = YOUNG1 ET YOUNG2 ET YOUNG3 ET NU1 ET NU2 ET NU3;
  16687. MAT22 = CIS1 ET CIS2 ET CIS3;
  16688. MAT33 = VRX1 et VRY1 et VZX1 et VZY1;
  16689. MAT44 = ALPH1 ET ALPH2 ET ALPH3 ET RHO;
  16690. FINSI;
  16691. SI ( EGA TYPEMAT MAS3D);
  16692. MAT11 = YOUNG1 ET YOUNG2 ET YOUNG3 ET NU1 ET NU2 ET NU3;
  16693. MAT22 = CIS1 ET CIS2 ET CIS3;
  16694. MAT33 = VRX1 et VRY1 et VRZ1 et VZX1 et VZY1 et VZZ1;
  16695. MAT44 = ALPH1 ET ALPH2 ET ALPH3 ET RHO;
  16696. FINSI;
  16697.  
  16698. MAT1 = MAT11 ET MAT22 ET MAT33 ET MAT44;
  16699. MATGEO = CHAN TYPE MAT1 CARACTERISTIQUES;
  16700.  
  16701. FINPROC MATGEO MODL1 ;
  16702.  
  16703.  
  16704. **** @PDROP
  16705. DEBPROC @PDROP TAB1*TABLE ;
  16706. *************************************************************************
  16707. * CALCUL CHUTE DE PRESSION *
  16708. *************************************************************************
  16709. *123456789012345678901234567890123456789012345678901234567890123456789012
  16710. * 1 2 3 4 5 6 7*
  16711. MESS ' ';
  16712. NIVEAU = TAB1 . 'NIVEAU';
  16713. *
  16714. SI (NIVEAU >EG 4) ;
  16715. MESS '---------------------------------> calling @PDROP';
  16716. FINSI ;
  16717. *
  16718. * entrees
  16719. *
  16720. DIAM = TAB1 . 'D_MAQUETTE' ;
  16721. VIT = TAB1 . 'V_IN' ;
  16722. TEAU = TAB1 . 'T_IN' ;
  16723. LMAQ = TAB1 . 'L_MAQUETTE' ;
  16724. LH = TAB1 . 'L_HEATED' ;
  16725. PIN = TAB1 . 'P_IN' ;
  16726. TAPE = TAB1 . 'T_TAPE' ;
  16727. YTW = TAB1 . 'TWIST_RATIO' ;
  16728. *
  16729. SI ( NON ( EXISTE TAB1 ORIGIN_LH)) ;
  16730. TAB1 . ORIGIN_LH = 0. ;
  16731. SI (NIVEAU >EG 2) ;
  16732. MESS '>@PDROP> ORIGIN_LH set to default value : 0';
  16733. FINSI ;
  16734. FINSI ;
  16735. ZLH = TAB1 . 'ORIGIN_LH' ;
  16736.  
  16737. PI = 3.14159 ;
  16738. *
  16739. *****************TABLE DE L EAU***************************************
  16740. *--- RHO de l eau en fonction de la temperature
  16741. PTRHO = PROG 0. 20. 40. 60. 80. 100. 120. 140. 160. 180. 200. 220. 240. 260. 280.6 300. ;
  16742. PRHOF = PROG 1022.3 1000.5 994.6 985.5 974.1 960.6 945.3 928.3 909.7 889.0 866.8 842.4 815.7 785.9 752.6 714.3 ;
  16743. *--- VISCO de l eau en fonction de la temperature
  16744. PTNNU = PROG 0. 20. 40. 60. 80. 100. 120. 140. 160. 180. 200. 220. 240. 260. 280.6 300. ;
  16745. PNNU = PROG 1.8E-3 1.E-3 .65E-3 .47E-3 .35E-3 .28E-3 .23E-3 .20E-3 .172E-3 .154E-3 .138E-3 .126E-3 .117E-3 .108E-3 .102E-3 .96E-4 ;
  16746. **********************************************************************
  16747. RHO_N = IPOL TEAU PTRHO PRHOF ;
  16748. N_NU = IPOL TEAU PTNNU PNNU ;
  16749. *
  16750. SI (YTW EGA 0.) ;
  16751. *
  16752. *---CANAL SANS SWIRL
  16753. DH = DIAM ;
  16754. VIT1 = VIT ;
  16755. SI ( EXISTE TAB1 RIP_FLOWS ) ;
  16756. S1 = ( TAB1 . RIP_FLOWS ) ;
  16757. FINSI ;
  16758. SI ( EXISTE TAB1 RIP_WETP ) ;
  16759. * PERI = ( TAB1 . RIP_WETP ) ;
  16760. * DH = 4. * S1 / PERI ;
  16761. DH = DIAM ;
  16762. FINSI ;
  16763. SI ( EXISTE TAB1 RIP_TWIST ) ;
  16764. PIS2Y = PI / ( 2. *( TAB1 . RIP_TWIST ) ) ;
  16765. FACV2 = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  16766. VIT1 = VIT * FACV2 ;
  16767. * FACV = MAXI ( PROG FACV FACV2 ) ;
  16768. FINSI ;
  16769. RE = VIT1 * DH / ( N_NU / RHO_N ) ;
  16770. MESS '>@PDROP> HYD. DIAM. :' DH ;
  16771. MESS '>@PDROP> VITESSE :' VIT1 ;
  16772. MESS '>@PDROP> REYNOLDS :' RE ;
  16773. * F_FRICT = TAB1.'LAMBDA' ;
  16774. * SI ( RE < 2.E4 ) ;
  16775. * MESS '>@PDROP> F_FRICT = 0.316 * ( RE ** -0.25 )' ;
  16776. * F_FRICT = 0.316 * ( RE ** -0.25 ) ;
  16777. * SINON ;
  16778. * MESS '>@PDROP> F_FRICT = 0.184 * ( RE ** -0.20 )' ;
  16779. * F_FRICT = 0.184 * ( RE ** -0.20 ) ;
  16780. * FINSI ;
  16781. * COEF = F_FRICT * LMAQ / DH ;
  16782. * PERT = RHO_N * (VIT ** 2.) /2. ;
  16783. SI ( EXISTE TAB1 'LAMBDA') ;
  16784. F_FRICT = TAB1.'LAMBDA' ;
  16785. MESS '>@PDROP> frict. fact. given:' F_FRICT ;
  16786. SINON ;
  16787. F_FRICT = (1.82*(LOG RE)/(LOG 10.) - 1.64) ** -2. ;
  16788. MESS '>@PDROP> F_FRICT=((1.82*(log10 RE)) - 1.64) ** -2.:' F_FRICT;
  16789. FINSI ;
  16790. DPRES = F_FRICT * LMAQ / DH * RHO_N * (VIT ** 2.) /2. ;
  16791.  
  16792. SINON ;
  16793. *
  16794. *--- CANAL AVEC SWIRL
  16795. QUASI = ((PI * DIAM * DIAM / 4.) - (TAPE * DIAM)) ;
  16796. PERII = ((PI * DIAM)+(2.*(DIAM - TAPE))) ;
  16797. DHI = 4. * QUASI / PERII ;
  16798. *
  16799. PYI = PI / (2. * YTW ) ;
  16800. F1 = (1.+( PYI ** 2. ))**(0.5) ;
  16801. RE = F1 * VIT * DHI / ( N_NU / RHO_N ) ;
  16802. MESS '>@PDROP> HYD. DIAM. :' DHI ;
  16803. MESS '>@PDROP> VITESSE LONG. :' VIT ;
  16804. MESS '>@PDROP> VITESSE UTILE :' (VIT * F1) ;
  16805. MESS '>@PDROP> REYNOLDS :' RE ;
  16806. KFRIC = 0.3 * ( RE ** -0.25 ) ;
  16807. *
  16808. * DPRI = 0.15 * ( DHI ** -1.25 ) * ((N_NU / RHO_N)**0.25)
  16809. * * ( F1 ** 2.75 ) ;
  16810. * DPRE = RHO_N * ( VIT ** 1.75 ) ;
  16811. * DPRES = DPRI * DPRE * LMAQ ;
  16812. *---facteur correctif
  16813. * AF = 1.46 ;
  16814. * BF = 10100 ;
  16815. * DPRES = (DPRES * AF) + BF ;
  16816. DPRES = 0.158 * ((N_NU / RHO_N)**0.25) * ( DHI ** -1.25 ) * ( F1 ** 2.84 ) * LMAQ * RHO_N * ( VIT ** 1.84 ) ;
  16817. *
  16818.  
  16819. FINSI ;
  16820. *
  16821. *---DIFFERENTES PRESSIONS DANS LA MAQUETTE
  16822. *
  16823. TAB1 . V_RHO_N = RHO_N ;
  16824. POUT = PIN - DPRES ;
  16825. PIN_LC = PIN - (DPRES * ZLH / LMAQ ) ;
  16826. POUT_LC = PIN - (DPRES * (ZLH + LH) / LMAQ ) ;
  16827. PRESMOY = (PIN_LC + POUT_LC) / 2. ;
  16828. *
  16829. MESS '>@PDROP> PIN :' PIN ;
  16830. MESS '>@PDROP> PIN HEATED LENGHT :' PIN_LC ;
  16831. MESS '>@PDROP> POUT HEATED LENGHT :' POUT_LC ;
  16832. MESS '>@PDROP> POUT :' POUT ;
  16833. MESS '>@PDROP> MEAN PRESS. :' PRESMOY ;
  16834. MESS '>@PDROP> DP :' DPRES ;
  16835. SI (NIVEAU >EG 4) ;
  16836. MESS '---------------------------------> exiting @PDROP';
  16837. FINSI ;
  16838. FINPROC DPRES PIN_LC POUT_LC POUT ;
  16839. **** @PPERM
  16840. DEBPROC @PPERM TAB1*'TABLE' ITE1/'ENTIER';
  16841. SI (NON (EXISTE TAB1 NISOV)) ;
  16842. TAB1.NISOV = 7 ;
  16843. FINSI ;
  16844. *23456789012345678901234567890123456789012345678901234567890123456789012
  16845. * 1 2 3 4 5 6 7
  16846. *
  16847. NIVEAU = TAB1.'NIVEAU' ;
  16848. SI (NIVEAU >EG 4) ;
  16849. MESS ' -------------------> calling @PPERM';
  16850. FINSI ;
  16851. MESS ' ';
  16852. MESS ' ';
  16853. MESS ' ######################################################### ';
  16854. MESS ' POST TRAITEMENT DES CALCULS THERMIQUES STATIONAIRES ';
  16855. MESS ' ######################################################### ';
  16856. MESS ' ';
  16857. MESS ' ';
  16858.  
  16859. * RM 07/03/97
  16860. * pb dans les legendes des traces : il faudrait faire le menage
  16861. *
  16862. *
  16863. *
  16864. *
  16865. *
  16866. *
  16867. *JS 11/1/95 TAB1.V_FACFM1 est utilise pour le calcul de la puissance
  16868. * donnee en commentaire sur les courbes
  16869. *le probleme est que dans le cas d un lambdaq TAB1.LIS_FLUX contient
  16870. * la liste des PHI0 a traiter et non le flux moyen commme dans le
  16871. * cas canon le plus simple serait peut etre d exiger LIS_PHI0
  16872. * et de CREER LIS_FLUMOYEN dans ce cas....
  16873. *
  16874. *
  16875. si (existe tab1 points) ;
  16876. ind1 = inde (tab1.points) ;
  16877. finsi ;
  16878. *
  16879. * INITIALISATION DES PROG
  16880. *
  16881. SI ((NON (EXISTE TAB1 GRAPH1)) OU (NON (EXISTE ITE1 )));
  16882. TAB1.GRAPH1 = TABLE;
  16883. TAB1.GRAPH1.LITICZ = PROG;
  16884. TAB1.GRAPH1.LITMCZ = PROG;
  16885. TAB1.GRAPH1.LITMP = PROG;
  16886. TAB1.GRAPH1.LIFLU = PROG;
  16887. TAB1.GRAPH1.LIFL = PROG;
  16888. TAB1.GRAPH1.LIFLUM = PROG;
  16889. TAB1.GRAPH1.FLUCRIT = PROG;
  16890. TAB1.GRAPH1.FLUCRITJB = PROG;
  16891. TAB1.GRAPH1.LIFLUEV = PROG;
  16892. TAB1.GRAPH1.LIFLUP = PROG;
  16893. TAB1.GRAPH1.LIFLUC = PROG;
  16894. TAB1.GRAPH1.LIFLUR = PROG;
  16895. TAB1.GRAPH1.L90PF = PROG;
  16896. TAB1.GRAPH1.L80PF = PROG;
  16897. TAB1.GRAPH1.L70PF = PROG;
  16898. TAB1.GRAPH1.POFLUC = PROG;
  16899. TAB1.GRAPH1.POFLUR = PROG;
  16900. IPP1 = 0 ;
  16901.  
  16902. si (existe tab1 li_point) ;
  16903. TAB1.LIS_TEMP = TABLE ;
  16904. REPETER BOUPO6 (DIME TAB1.LI_POINT);
  16905. IPP1 = IPP1 + 1 ;
  16906. TAB1.LIS_TEMP . IPP1 = PROG;
  16907. FIN BOUPO6;
  16908. finsi ;
  16909. si (existe tab1 points) ;
  16910. TAB1.LIS_TEMP = TABLE ;
  16911. TAB1.LIS_TEMP . 0 = PROG;
  16912. REPETER BOUPO6 ;
  16913. si (exis ind1 &BOUPO6) ;
  16914. TAB1.LIS_TEMP . &BOUPO6 = PROG;
  16915. sinon ;
  16916. quitter BOUPO6 ;
  16917. finsi ;
  16918. FIN BOUPO6;
  16919. finsi ;
  16920.  
  16921. SI ( EXISTE TAB1 EVEXP) ;
  16922. TAB2 = INDEX (TAB1.EVEXP) ;
  16923. IPP1 = 0 ;
  16924. TAB1.LIS_FPAROI = TABLE ;
  16925. TAB1.LIS_DTPAROI = TABLE ;
  16926. TAB1.LIS_DTEXP = TABLE ;
  16927. REPETER BOUPO7 (DIME TAB2) ;
  16928. IPP1 = IPP1 + 1;
  16929. TAB1.LIS_FPAROI . IPP1 = PROG ;
  16930. TAB1.LIS_DTPAROI . IPP1 = PROG ;
  16931. TAB1.LIS_DTEXP . IPP1 = PROG ;
  16932. FIN BOUPO7;
  16933. FINSI ;
  16934.  
  16935. FINSI;
  16936. SI (NON (EXISTE ITE1 ));
  16937. NN1 = DIME TAB1.LIS_FLUX ;
  16938. ITER = 0 ;
  16939. SINON ;
  16940. NN1 = 1 ;
  16941. ITER = ITE1 ;
  16942. FINSI;
  16943. SI (NON (EXISTE TAB1 LFLUX_CONV_DESS ));
  16944. TAB1.LFLUX_CONV_DESS = TAB1.LFLUX_CONV ;
  16945. FINSI;
  16946. *
  16947. * DEBUT DU POST TRAITEMENT : EXTRACTION DES 'T' ET 'H' -> TRACE ISOV.
  16948. *
  16949. *
  16950. COTETF1 = TAB1.C_COTETF1;
  16951. SITETF1 = TAB1.C_SITETF1;
  16952.  
  16953. COTETR1 = TAB1.C_COTETR1;
  16954. SITETR1 = TAB1.C_SITETR1;
  16955.  
  16956. COTETC1 = TAB1.C_COTETC1;
  16957. SITETC1 = TAB1.C_SITETC1;
  16958.  
  16959.  
  16960. S_TOT1 = TAB1.'M_ILLAGE_TOT';
  16961. C_ONT1 = TAB1.'M_IL_CONTOUR';
  16962.  
  16963. SI (EXISTE TAB1 'MAIL_TOT_DESS' );
  16964. S_TOT2 = TAB1.'MAIL_TOT_DESS';
  16965. C_ONT2 = TAB1.'MAIL_CONTOUR_DESS';
  16966. SINON ;
  16967. S_TOT2 = TAB1.'M_ILLAGE_TOT';
  16968. C_ONT2 = TAB1.'M_IL_CONTOUR';
  16969. FINSI ;
  16970.  
  16971. REPETER BOO1 NN1 ;
  16972.  
  16973. SI (NON (EXISTE ITE1 ));
  16974. ITER = ITER + 1 ;
  16975. FINSI ;
  16976. MESS ' ';
  16977. MESS '---------------------------------------';
  16978. MESS ' Exploitation of Step number ' ITER ;
  16979. MESS ' Heat flux [MW/m2] ' ((EXTR TAB1.LIS_FLUX ITER)/1.E6);
  16980. MESS ' ';
  16981.  
  16982. VFPAT1 = TAB1.V_VPAT1 * (EXTR TAB1.LIS_FLUX ITER);
  16983. * FLU1 est le flux moyen
  16984. SI ( EXISTE TAB1 'LAMDAQ' );
  16985. SI ( EXISTE TAB1 'V_FACFM1');
  16986. FLU1 = (EXTR TAB1.LIS_FLUX ITER) * TAB1.V_FACFM1 ;
  16987. SINON ;
  16988. FLU1 = (EXTR TAB1.LIS_FLUX ITER) * TAB1.'V_FACFM2';
  16989. FINSI ;
  16990. * FLU1 = (EXTR TAB1.LIS_FLUX ITER) * TAB1.V_FACFM1;
  16991. *js15.5.97* SI ( EXISTE TAB1 'CENTRE_PLASMA' );
  16992. *js15.5.97* PUI1 = FLU1 * (TAB1 . B_HEATED) * (TAB1.WE_HEATED );
  16993. *js15.5.97* SINON;
  16994. *js15.5.97* PUI1 = FLU1 * (TAB1 . L_HEATED) * (TAB1.WE_HEATED );
  16995. *js15.5.97* FINSI;
  16996. SINON;
  16997. FLU1 = (EXTR TAB1.LIS_FLUX ITER);
  16998. *js15.5.97* PUI1 = FLU1 * (TAB1 . L_HEATED) * (TAB1.W_HEATED );
  16999. TAB1 . WE_HEATED = TAB1 . W_HEATED;
  17000. FINSI;
  17001. PUI1 = RESU TAB1.I_FPAT1.ITER ;
  17002. *
  17003. MOTITR = TAB1.TITR_MAQ ;
  17004. TITRE MOTITR '- ISOV. T. VAL FLUX: ' FLU1 'VAL PUIW LIN MAIL :' PUI1;
  17005. *123456789012345678901234567890123456789012345678901234567890123456789012
  17006. TE1 = TAB1.ITER;
  17007. SI ( EXISTE TAB1 LIS_TPER );
  17008. III1 = EXTR TAB1.LIS_TPER ITER;
  17009. SINON;
  17010. III1 = FLOT ITER;
  17011. FINSI;
  17012. CHT1 = EXCO 'T' TE1;
  17013. *<JS deb
  17014. SI ( EGA ( TYPE ( TAB1.RESUTHER.'VALEUR_TETA'.ITER)) 'CHPOINT ');
  17015. V_TETA = EXCO 'T' ( TAB1.RESUTHER.'VALEUR_TETA'.ITER) ;
  17016. SINON ;
  17017. V_TETA = TAB1.RESUTHER.'VALEUR_TETA'.ITER;
  17018. FINSI ;
  17019. HCONVT1 = EXCO 'H' ( TAB1.RESUTHER.COEFECHANGE.ITER ) ;
  17020. HCONRT1 = EXCO 'H' ( TAB1.RESUTHER.COEFRAYONNE.ITER ) ;
  17021. *<JS fin
  17022. *
  17023. MESS ' MAXI MINI TEMPERATURES ' ( MAXI CHT1) ( MINI CHT1 ) ;
  17024. CHTI0 = ( REDU CHT1 TAB1.LFLUX_CONV ) ;
  17025. MACHTI0 = MAXI CHTI0 ;
  17026. MICHTI0 = MINI CHTI0 ;
  17027. CHTI2 = CHTI0 * 1.E5 ;
  17028. *<JS deb
  17029. CHTI1 = CHTI0 - V_TETA ;
  17030. FLH1 = FLUX (TAB1.'MODELV') ( HCONVT1 * -1. );
  17031. FLI1 = FLH1 * CHTI1 ;
  17032. FLI2 = HCONVT1 * CHTI1 ;
  17033. *<JS fin
  17034. *<JS>FLI2 = @IPOE CHTI0 TAB1.'EV_FLUX_CONV'.ITER ;
  17035. *<JS>FLI1 = FLUX (TAB1.'MODELV') (FLI2 * -1.);
  17036. MESS ' MAXI MINI TEMP. CONV ' ( MAXI CHTI0) ( MINI CHTI0) ;
  17037. *
  17038. CHTIR0 = ( REDU CHT1 (TAB1.LFLUX_RAYO) ) ;
  17039. CHTIR2 = CHTIR0 * 1.E5 ;
  17040. *<JS deb
  17041. CHTIR1 = CHTIR0 - TAB1.TEMP_RAYO;
  17042. FLHR1 = FLUX (TAB1.'MODELR') ( HCONRT1 * -1. );
  17043. FLIR1 = FLHR1 * CHTIR1;
  17044. FLIR2 = HCONRT1 * CHTIR1;
  17045. *<JS fin
  17046. *<JS>FLIR2 = @IPOE CHTIR0 TAB1.'EV_FLUX_RAYO'.ITER ;
  17047. *<JS>FLIR1 = FLUX (TAB1.'MODELR') ( FLIR2 * -1. );
  17048. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  17049. AMPLV1 = ( TAB1 . DH ) / (2. * TAB1.MAX_SOFL ) ;
  17050. SINON ;
  17051. AMPLV1 = ( TAB1 . D_MAQUETTE ) / (2. * TAB1.MAX_SOFL);
  17052. FINSI ;
  17053. CHPX = EXCO SCAL ( FLIR2 * ( COTETR1 ) ) UX;
  17054. CHPY = EXCO SCAL ( FLIR2 * ( SITETR1 ) ) UY;
  17055. CHPT = @ET CHPX CHPY;
  17056. SI( EGA 3 (VALE DIME));
  17057. C3TETR1 = TAB1.C_C3TETR1;
  17058. CHPZ = EXCO SCAL ( FLIR2 * ( C3TETR1 ) ) UZ;
  17059. CHPT = @ET CHPT CHPZ;
  17060. FINSI ;
  17061. CHPT = REDU CHPT S_TOT2 ;
  17062. TAB1. V_VEC33 = @VECADA CHPT AMPLV1 'ROUGE' ;
  17063. MESS ' MAXI MINI TEMP. RAYO ' ( MAXI CHTIR0) ( MINI CHTIR0) ;
  17064. *>MESS ' MAXI MINI DT RAYO ' ( MAXI CHTIR1) ( MINI CHTIR1) ;
  17065. *>MESS ' MAXI MINI H RAYO ' ( MAXI HCONRT1) ( MINI HCONRT1);
  17066. MESS ' MAXI MINI FLUX RAYO ' ( MAXI FLIR2) ( MINI FLIR2);
  17067. MESS ' MAXI MINI FLUX CONV ' ( MAXI FLI2 ) ( MINI FLI2 ) ;
  17068. *
  17069. *--- CREATION DES FLECHES (FLUX) :
  17070. *
  17071. CHPX = EXCO SCAL ( FLI2 * ( COTETC1 ) ) UX;
  17072. CHPY = EXCO SCAL ( FLI2 * ( SITETC1 ) ) UY;
  17073. CHPT = @ET CHPX CHPY;
  17074. SI( EGA 3 (VALE DIME));
  17075. C3TETC1 = TAB1.C_C3TETC1;
  17076. CHPZ = EXCO SCAL ( FLI2 * ( C3TETC1 ) ) UZ;
  17077. CHPT = @ET CHPT CHPZ;
  17078. FINSI ;
  17079. CHPT = REDU CHPT S_TOT2 ;
  17080. TAB1. V_VEC1 = @VECADA CHPT ( 1. * AMPLV1) 'ROUGE' ;
  17081.  
  17082. CHPX = EXCO SCAL ( VFPAT1 * ( COTETF1 ) ) UX ;
  17083. CHPY = EXCO SCAL ( VFPAT1 * ( SITETF1 ) ) UY ;
  17084. CHPT = (@ET CHPX CHPY );
  17085. SI( EGA 3 (VALE DIME));
  17086. C3TETF1 = TAB1.C_C3TETF1;
  17087. CHPZ = EXCO SCAL ( VFPAT1 * ( C3TETF1 ) ) UZ;
  17088. CHPT = @ET CHPT CHPZ;
  17089. FINSI ;
  17090. CHPT = REDU CHPT S_TOT2 ;
  17091. TAB1. V_VEC22 = @VECADA (-1. * CHPT) ( -1. * AMPLV1 ) 'VERT' ;
  17092.  
  17093. *
  17094. * --- TRACE DES ISOVALEURS ET DES FLUX
  17095. *
  17096. VEC_00 = TAB1.V_VEC22 ET TAB1.V_VEC1 ET TAB1.V_VEC33 ;
  17097. TE2 = REDU TAB1.ITER S_TOT2 ;
  17098. TRAC 'CACH' TAB1.VIEW_P TAB1.NISOV TE2 S_TOT2 VEC_00 C_ONT2;
  17099.  
  17100. SI ( EXISTE TAB1 VIEW_P2 );
  17101. TRAC CACH TAB1.VIEW_P2 TAB1.NISOV TE2 S_TOT2 C_ONT2 (VEC1 VEC22 VEC_33);
  17102. FINSI;
  17103.  
  17104. SI ( NON( EXISTE TAB1 TRAC_GRAD ) );
  17105. TAB1.TRAC_GRAD = FAUX;
  17106. FINSI;
  17107.  
  17108. SI TAB1.TRAC_GRAD;
  17109. MO_TOT = MODE S_TOT1 'THERMIQUE' 'ISOTROPE';
  17110. VEGRA1 = @VECGRAD MO_TOT TAB1.RESUTHER.CONDUCMAT.ITER TE1 AMPLV1 'ROUGE';
  17111. TRACER TAB1.VIEW_P CACH TE1 S_TOT1 C_ONT1 VEGRA1 ;
  17112. FINSI ;
  17113. *
  17114. *--- TRACE DES COURBES: 'H' 'TEMP. ET FLUX SUR PAROI'
  17115. *
  17116. *>MESS ' COEF ECH SUR LA PAROI ' ;
  17117. *>MESS ' MAXI MINI ' ( MAXI HCONVT1 ) ( MINI HCONVT1 ) ;
  17118. TAB1.'FLUPAROI' = FLI2 ;
  17119. MESS ' ';
  17120.  
  17121. SI ( NON ( EXISTE TAB1 COEF_ECH_V_ABS ) ) ;
  17122. TAB1.COEF_ECH_V_ABS = FAUX ;
  17123. FINSI ;
  17124.  
  17125. SI ( TAB1.COEF_ECH_V_ABS ) ;
  17126. *> TITRE ' WALL HEAT TRANSFER COEF. (MAXI : ' ( MAXI HCONVT1 ) ;
  17127. *> TAB1.EVHS = EVOL VERT 'CHPO' ( HCONVT1 ) SCAL TAB1.LFLUX_CONV_DESS ;
  17128. *> TAB1.CH_H = REDU HCONVT1 TAB1.LFLUX_CONV ;
  17129. *> DESSIN TAB1.EVHS YBOR 0. 3.e5 'MARQ CROI REGU' ;
  17130. FINSI ;
  17131. * fin jb
  17132. SI( EGA 3 (VALE DIME));
  17133. MESS '>>>> @PPERM>>>> ATTENTION EN 3D TAB1.LFLUX_CONV_DESS';
  17134. MESS '>>>> @PPERM>>>> doit etre une ligne de TAB1.LFLUX_CONV';
  17135. FINSI ;
  17136. * --- courbe 1 -> de temperature de la paroi fonction de l'abscisse
  17137. *TITRE ' TEMP. PAROI ' ;
  17138. FLI0 = MANU CHPO TAB1.LFLUX_CONV_DESS 1 'SCAL' 0. ;
  17139. *js EVCHTI21 = EVOL 'CHPO' CHTI2 SCAL TAB1.LFLUX_CONV_DESS ;
  17140. EVCHTI21 = EVOL ROUG 'CHPO' (@ET CHTI2 FLI0) SCAL TAB1.LFLUX_CONV_DESS ;
  17141. EVTPAROI = EVOL ROUG 'CHPO' (@ET CHTI0 FLI0) SCAL TAB1.LFLUX_CONV_DESS ;
  17142.  
  17143. * --- courbe 2 -> de l'evolution totale tonb
  17144. *TITRE MOTITR 'WALL FLUX AND TEMP. FLUX: ' FLU1;
  17145. PLINT11 = EXTR EVCHTI21 ABSC;
  17146. EVTONB1 = EVOL ROUG MANU PLINT11 (PROG (DIME PLINT11)*(TAB1.V_TONB * 1.E5));
  17147.  
  17148. * --- courbe 3 -> flux a la paroi fonction de l'abscisse
  17149. *TITRE ' FLUX PAROI ' ;
  17150. *js EVFLI11 = EVOL 'CHPO' FLI2 SCAL TAB1.LFLUX_CONV_DESS ;
  17151. FLI0 = MANU CHPO TAB1.LFLUX_CONV_DESS 1 'SCAL' 0. ;
  17152. EVFLI11 = EVOL VERT 'CHPO' (@ET FLI2 FLI0) SCAL TAB1.LFLUX_CONV_DESS ;
  17153. EVFPAROI = EVFLI11 ;
  17154.  
  17155. * --- courbe 4 -> Valeur demi du flux a la paroi
  17156. *TITRE ' DEMI FLUX PAROI ' ;
  17157. EVFL1S2 = EVOL VERT MANU PLINT11 (PROG (DIME PLINT11)*((MAXI FLI2) / 2.));
  17158.  
  17159.  
  17160. EVE_PREP = EVCHTI21 ET EVTONB1 ET EVFLI11 ET EVFL1S2 ;
  17161. EVE_PRJB = EVE_PREP ;
  17162. *
  17163. * --- pr\E9paration des l\E9gendes
  17164. *
  17165. * les temperatures ont des symboles ouverts
  17166. * les flux des symboles fermes
  17167. TAC2 = TABLE;
  17168. TAC2.TITRE = TABLE ;
  17169. TAC2.1 = 'MARQ CROI REGU' ; TAC2.TITRE.1 = 'WALL_TEMP' ;
  17170. TAC2.2 = 'MARQ ETOI REGU' ; TAC2.TITRE.2 = 'TONB' ;
  17171. TAC2.3 = 'MARQ LOSA REGU' ; TAC2.TITRE.3 = 'WALL_FLUX' ;
  17172. TAC2.4 = 'MARQ TRIB REGU' ; TAC2.TITRE.4 = 'HALF_FLUX' ;
  17173. TAC2.5 = 'MARQ CARR REGU' ; TAC2.TITRE.5 = 'TONG75' ;
  17174. * a ce niveau, t,tonb, Wallflux sont pret a etre traces
  17175. * traces des diff\E9rents flux critiques demand\E9s
  17176.  
  17177. LLL1 = MOTS 'CARR' 'TRIA' 'TRIB' 'CARR' 'TRIA' 'TRIB';
  17178. TITR 'FLUX AND TEMPERATURE WALL EVOLUTION';
  17179.  
  17180. I1 = 1 ;
  17181. REPETER BOUC6 (DIME TAB1.FLUX_CRITIQUE.ITER) ;
  17182. EVE_PREP = EVE_PREP ET (EVOL VERT MANU PLINT11 (PROG (DIME PLINT11)* (EXTR TAB1.FLUX_CRITIQUE.ITER I1 )));
  17183.  
  17184. SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'TONG 75') ;
  17185. VALTI1 = TAB1.M_TONG ;
  17186. FINSI ;
  17187. SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'BOWR') ;
  17188. VALTI1 = 'BOWRING72' ;
  17189. FINSI ;
  17190. SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'CELA') ;
  17191. VALTI1 = 'CELATA94' ;
  17192. FINSI ;
  17193.  
  17194. TAC2.(4 + I1) = CHAI 'MARQ ' (EXTR LLL1 I1) ' REGU TITRE ' VALTI1 ;
  17195. I1 = I1 + 1 ;
  17196. FIN BOUC6 ;
  17197. SI ( NON ( EXISTE TAB1 M_TONGJB ) ) ;
  17198. TAB1.M_TONGJB = FAUX ;
  17199. FINSI ;
  17200.  
  17201. SI TAB1.M_TONGJB ;
  17202. SI ((DIME TAB1.CHFCORRELATION) > 1) ;
  17203. ERRE 'trop de correlations : incompatible avec TAB1.M_TONGJB';
  17204. FINSI ;
  17205. EVCHF2 = EVOL JAUN MANU PLINT11 (PROG (DIME PLINT11) *(EXTR TAB1.FLUX_CRITIQUE.ITER 1)) ;
  17206. EVCHFJB = EVOL JAUN MANU PLINT11 (PROG (DIME PLINT11)*(TAB1.FLJB_CRI_TONG.ITER)) ;
  17207. TAC2.6 = 'MARQ CARR REGU TITRE 1.67*TONG75' ;
  17208. TAC2.7 = 'MARQ TRIB REGU TITRE TONG75 CHF' ;
  17209. DESSIN (EVE_PRJB ET EVCHF2 ET EVCHFJB) LEGE MIMA TAC2 ;
  17210. SINON ;
  17211. DESSIN EVE_PREP LEGE MIMA TAC2 ;
  17212. TAB1.EVE_PREP1 = EVE_PREP ;
  17213. FINSI ;
  17214. MESS ' TEMP MAXI SUR PAROI : ' MACHTI0 ;
  17215. MESS ' TEMP MINI SUR PAROI : ' MICHTI0 ;
  17216. SI (EXISTE TAB1 LO_FLUI) ;
  17217. SI TAB1.LO_FLUI;
  17218. TEX_1 = (REDU CHT1 (TAB1.LFLUX_EXTE_DESS ));
  17219. EVTEX1 = EVOL 'CHPO' (TEX_1 * 1.E4) 'SCAL' (TAB1.LFLUX_EXTE_DESS);
  17220. EVFLEX1 = EVOL 'CHPO' VFPAT1 'SCAL' (TAB1.LFLUX_EXTE_DESS);
  17221. TITRE 'INCIDENT FLUX AND TEMPERATURE ' FLU1;
  17222. TAC2.1 = 'MARQ CROI REGU TITRE INCIDENT_FLUX' ;
  17223. TAC2.3 = 'MARQ CARR REGU TITRE L_EXT_TEMP' ;
  17224. DESSIN (EVFLEX1 ET EVTEX1) LEGE MIMA TAC2 ;
  17225. FINSI ;
  17226. FINSI ;
  17227. *
  17228. * --- EXTRACTION DES TEMP. AUX PTS DESIRES
  17229. SI ( EXISTE TAB1 LI_POINT ) ;
  17230. *
  17231. * les 10 lignes suivantes sont assez d\E9licates
  17232. * svp ne pas modifier sans l'avis de RM ou JS
  17233. *
  17234. IPP1 = 0;
  17235. REPETER BOUPO1 (DIME TAB1.LI_POINT) ;
  17236. IPP1 = IPP1 + 1;
  17237. T_P1 = 'TEXT' ('EXTR' IPP1 TAB1.LI_POINT);
  17238. *js cast95 n'accepte plus un text ds EXTR
  17239. *js donc on lui recree le point
  17240. T_P3 = S_TOT1 'POIN' 'PROC' (T_P1) ;
  17241. T_P2 = EXTR IPP1 TAB1.LI_POINT ;
  17242. * list (T_P1) ;
  17243. TMIP1 = EXTR TE1 'T' T_P3;
  17244. MESS ' TEMPERATURE ................... : ' TMIP1 'EN ' T_P2;
  17245. TAB1.LIS_TEMP . IPP1 = ( TAB1.LIS_TEMP . IPP1 ) ET ( PROG TMIP1 ) ;
  17246. FIN BOUPO1;
  17247. FINSI ;
  17248.  
  17249. * autre syntaxe pour le meme resultat, RM101098
  17250. si (existe tab1 points) ;
  17251. repe boupo7 ;
  17252. si (existe ind1 &boupo7) ;
  17253. nom1 = ind1.&boupo7 ;
  17254. poa1 = tab1.points.nom1 ;
  17255. IPP1 = &boupo7 ;
  17256. TMIP1 = EXTR TE1 'T' poa1;
  17257. MESS ' TEMPERATURE ................... : ' TMIP1 'EN ' nom1;
  17258. TAB1.LIS_TEMP . IPP1 = ( TAB1.LIS_TEMP . IPP1 ) ET ( PROG TMIP1 ) ;
  17259. sinon ;
  17260. quitter boupo7 ;
  17261. finsi ;
  17262. fin boupo7;
  17263. finsi ;
  17264.  
  17265. MESS ' ';
  17266. IPP1 = 0;
  17267. REPETER BOUMA1;
  17268. IPP1 = IPP1 + 1;
  17269. SI ( EXISTE (TAB1.ZONE_MAT) IPP1 ) ;
  17270. TMMA1 = MAXI ( REDU CHT1 (TAB1.ZONE_MAT.IPP1 ) );
  17271. TIMA1 = MINI ( REDU CHT1 (TAB1.ZONE_MAT.IPP1 ) );
  17272. *****MESS ' SWIRL TAPE THICKNESS (M) : ' TTAPE;
  17273. MESS ' TEMPERATURE MAXI............... : ' TMMA1 'MAT. ' (TAB1.NOM_MAT.IPP1 );
  17274. MESS ' TEMPERATURE MINI............... : ' TIMA1 'MAT. ' (TAB1.NOM_MAT.IPP1 );
  17275. SINON ;
  17276. QUITTER BOUMA1 ;
  17277. FINSI ;
  17278. FIN BOUMA1;
  17279.  
  17280. MESS ' ' ;
  17281. MESS 'densite de flux de chaleur (W/m\B2)' ;
  17282. MESS ' ' ;
  17283. MESS ' FLUX MOYEN .....................: ' FLU1;
  17284. FLUMAE = ( MAXI VFPAT1);
  17285. MESS ' FLUX MAXI ENTRANT...............: ' FLUMAE;
  17286. FLUMIE = ( MINI VFPAT1);
  17287. MESS ' FLUX MINI ENTRANT...............: ' FLUMIE;
  17288. FLUMAS = ( MAXI FLI2 );
  17289. MESS ' FLUX MAXI SORTIE ...............: ' FLUMAS;
  17290. FLUMIS = ( MINI FLI2 );
  17291. MESS ' FLUX MINI SORTIE ...............: ' FLUMIS;
  17292. RPAT1 = MAXI (RESU TAB1.I_FPAT1.ITER);
  17293. *js15.5.97*PRPAT1 = ((RPAT1 * (TAB1.FSYM_X)) * TAB1.L_HEATED);
  17294. PRPAT1 = RPAT1 ;
  17295. RLI1 = MAXI ( RESU FLI1);
  17296. *js15.5.97*PRLI1 = ((RLI1 * (TAB1.FSYM_X)) * TAB1.L_HEATED);
  17297. PRLI1 = RLI1 ;
  17298. ARLI1 = ABS PRLI1;
  17299. POULI1 = ( ARLI1 /PRPAT1 ) * 100.;
  17300. RLIR1 = MAXI (RESU FLIR1);
  17301. *js15.5.97*PRLIR1 = ((RLIR1 *(TAB1.FSYM_X)) * TAB1.L_HEATED);
  17302. PRLIR1 = RLIR1 ;
  17303. ARLIR1 = ABS PRLIR1;
  17304. POULIR1 = ( ARLIR1 /PRPAT1 ) * 100.;
  17305. ***MESS ' SWIRL TAPE THICKNESS (M) : ' TTAPE;
  17306. SI ( EXISTE TAB1 'LAMDAQ' );
  17307. MESS ' LONGUEUR DE DECROISSANCE : ' TAB1.'LAMDAQ' ;
  17308. MESS ' FLUX DEMANDE PHIO : ' (EXTR TAB1.LIS_FLUX ITER);
  17309. FINSI;
  17310. MESS ' ' ;
  17311. MESS 'en 2D puissance en Watts par metre de tube (W/m)' ;
  17312. MESS ' ' ;
  17313. MESS ' RESULTANTE FLUX INCIDENT : ' RPAT1 ;
  17314. MESS ' RESULTANTE FLUX DE CONVECTION : ' RLI1 ;
  17315. MESS ' RESULTANTE FLUX DE RAYONNEMENT : ' RLIR1 ;
  17316.  
  17317. MESS ' ' ;
  17318. MESS 'en 2D puissance en Watts par metre sur la maquette maillee(W/m)' ;
  17319. MESS ' ' ;
  17320. MESS ' PUISSANCE INCIDENTE : ' PRPAT1 ;
  17321. MESS ' PUISSANCE DANS L EAU : ' PRLI1 '(' POULI1 '%)' ;
  17322. MESS ' PUISSANCE RAYONNEE : ' PRLIR1 '(' POULIR1 '%)' ;
  17323. MESS ' BILAN THERMIQUE : ' (PRPAT1 + PRLI1 + PRLIR1 );
  17324. TICZ1 = MINI CHT1;
  17325. TAB1.GRAPH1.LITICZ = TAB1.GRAPH1.LITICZ ET (PROG TICZ1);
  17326. TAB1.GRAPH1.LITMP = TAB1.GRAPH1.LITMP ET (PROG MACHTI0);
  17327. * attention RLIR1 est negatif
  17328. *js15.5.97*FLU11 = FLU1 + (RLIR1 / TAB1.W_HEATED * TAB1 . FSYM_X);
  17329. FLU11 = FLU1 + (RLIR1 / (MESU TAB1.LFLUX_RAYO) ) ;
  17330. MENAGE;
  17331.  
  17332. SI ( EXISTE TAB1 EVEXP) ;
  17333. * TAB2 = INDEX TAB1.EVEXP ;
  17334. IPP1 = 0 ;
  17335. REPETER BOUPO2 (DIME TAB2) ;
  17336. IPP1 = IPP1 + 1;
  17337. * T_P1 = 'TEXT' ('EXTR' IPP1 TAB1.LI_THEB);
  17338. T_P1 = 'TEXT' TAB2.IPP1 ;
  17339. T_P3 = S_TOT1 'POIN' 'PROC' (T_P1) ;
  17340. * T_P4 = EXTR IPP1 TAB1.LI_THEB ;
  17341. T_P4 = TAB2.IPP1 ;
  17342. T_TH1 = EXTR TE1 'T' T_P3;
  17343. TEXP_TH1 = @IPOE TAB1.EVEXP.T_P4 FLU11 ;
  17344.  
  17345. SI (TEXP_TH1 < (TAB1.V_TONB + 1.) ) ;
  17346. QUITTER BOUPO2;
  17347. SINON;
  17348. DTEXP_T1 = T_TH1 - TEXP_TH1 ;
  17349. MESS ' TEMPERATURE DE TH..calcule..... : ' T_TH1 'EN ' T_P4;
  17350. MESS ' TEMPERATURE experimentale...... : ' TEXP_TH1;
  17351. XPAROI = OPIE EVTPAROI T_TH1 'FIXE' ;
  17352. MESS ' ABSCISSE CURV ...........XPAROI : ' XPAROI;
  17353. TPAROI = @IPOE EVTPAROI XPAROI 'FIXE' ;
  17354. DTSATP = TPAROI - TAB1.T_SAT ;
  17355. DTSATEXP = DTSATP - DTEXP_T1 ;
  17356. * FPAROI = @IPOE EVFPAROI XPAROI 'FIXE' ;
  17357. FPAROI = @IPOE TAB1.EVOFE1 TPAROI 'FIXE' ;
  17358. MESS ' TPAROI FPAROI ..................: ' TPAROI FPAROI;
  17359. FINSI ;
  17360. SI ( (DTSATP &lt;EG 0. ) OU (DTSATEXP &lt;EG 0. ) );
  17361. QUITTER BOUPO2;
  17362. SINON;
  17363.  
  17364. TAB1.LIS_DTPAROI . IPP1 = ( TAB1.LIS_DTPAROI . IPP1 ) ET ( PROG DTSATP);
  17365. TAB1.LIS_DTEXP . IPP1 = ( TAB1.LIS_DTEXP . IPP1 ) ET ( PROG DTSATEXP);
  17366. TAB1.LIS_FPAROI . IPP1 = ( TAB1.LIS_FPAROI . IPP1 ) ET ( PROG FPAROI ) ;
  17367. FINSI ;
  17368. FIN BOUPO2;
  17369. FINSI ;
  17370. SI ( NON (EXISTE TAB1 LCAPKPC)); TAB1.LCAPKPC = VRAI; FINSI;
  17371. SI TAB1.LCAPKPC;
  17372. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  17373. ALPF90 PF90 = @CAPKPC EVFLI11 .9 TAB1.DH FLU11 NIVEAU;
  17374. ALPF80 PF80 = @CAPKPC EVFLI11 .8 TAB1.DH FLU11 NIVEAU;
  17375. ALPF70 PF70 = @CAPKPC EVFLI11 .7 TAB1.DH FLU11 NIVEAU;
  17376. SINON ;
  17377. ALPF90 PF90 = @CAPKPC EVFLI11 .9 TAB1.D_MAQUETTE FLU11 NIVEAU;
  17378. ALPF80 PF80 = @CAPKPC EVFLI11 .8 TAB1.D_MAQUETTE FLU11 NIVEAU;
  17379. ALPF70 PF70 = @CAPKPC EVFLI11 .7 TAB1.D_MAQUETTE FLU11 NIVEAU;
  17380. FINSI ;
  17381. TAB1.GRAPH1.L90PF = TAB1.GRAPH1.L90PF ET (PROG PF90);
  17382. TAB1.GRAPH1.L80PF = TAB1.GRAPH1.L80PF ET (PROG PF80);
  17383. TAB1.GRAPH1.L70PF = TAB1.GRAPH1.L70PF ET (PROG PF70);
  17384. FINSI ;
  17385.  
  17386. TAB1.GRAPH1.LIFL = TAB1.GRAPH1.LIFL ET (PROG FLU1);
  17387. TAB1.GRAPH1.LIFLU = TAB1.GRAPH1.LIFLU ET (PROG FLU11);
  17388. TAB1.GRAPH1.LIFLUM = TAB1.GRAPH1.LIFLUM ET (PROG FLUMAS);
  17389.  
  17390. TAB1.GRAPH1.FLUCRIT = TAB1.GRAPH1.FLUCRIT ET (PROG (EXTR TAB1.FLUX_CRITIQUE.ITER 1));
  17391. *jb
  17392. SI TAB1.M_TONGJB ;
  17393. TAB1.GRAPH1.FLUCRITJB = TAB1.GRAPH1.FLUCRITJB ET (PROG (EXTR TAB1.FLUX_CRITIQUE.ITER 1));
  17394. FINSI ;
  17395. *jb
  17396. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  17397. FLUEVAL = (FLU11 * (TAB1.W_HEATED) / TAB1.DH ) ;
  17398. SINON ;
  17399. FLUEVAL = (FLU11 * (TAB1.W_HEATED) / TAB1.D_MAQUETTE);
  17400. FINSI ;
  17401. TAB1.GRAPH1.LIFLUEV = TAB1.GRAPH1.LIFLUEV ET ( PROG FLUEVAL );
  17402. TAB1.GRAPH1.LIFLUP = TAB1.GRAPH1.LIFLUP ET ( PROG PRPAT1 );
  17403. TMCZ1 = MAXI CHT1;
  17404. TAB1.GRAPH1.LITMCZ = TAB1.GRAPH1.LITMCZ ET ( PROG TMCZ1);
  17405. TAB1.GRAPH1.LIFLUC = TAB1.GRAPH1.LIFLUC ET ( PROG ARLI1);
  17406. TAB1.GRAPH1.LIFLUR = TAB1.GRAPH1.LIFLUR ET ( PROG ARLIR1);
  17407. TAB1.GRAPH1.POFLUC = TAB1.GRAPH1.POFLUC ET ( PROG POULI1);
  17408. TAB1.GRAPH1.POFLUR = TAB1.GRAPH1.POFLUR ET ( PROG POULIR1);
  17409. *
  17410.  
  17411. FIN BOO1 ;
  17412.  
  17413. * Traces pour la derniere iteration
  17414. *
  17415. SI (EGA (DIME TAB1.LIS_FLUX) ITER);
  17416. *--- TRACE DES COURBES
  17417. *--- TEMP. DES PTS EN FCT DU FLUX INCIDENT CORRIGE ou reel
  17418. *
  17419. * SI ( NON ( EXISTE TAB1 PFLUXNCORR )) ;
  17420. TAB1 .PFLUXNCORR = VRAI ;
  17421. * FINSI ;
  17422. SI ( TAB1 .PFLUXNCORR ) ;
  17423. MOTFLU = 'INCIDENT FLUX ' ;
  17424. LLLFLU = TAB1.GRAPH1.LIFL ;
  17425. SINON ;
  17426. MOTFLU = 'ENTERING FLUX ' ;
  17427. LLLFLU = TAB1.GRAPH1.LIFLU ;
  17428. FINSI ;
  17429. TITRE 'SECTION TMIN CALCULATION';
  17430. EVTIC = EVOL MANU MOTFLU LLLFLU 'TEMPERATURE' TAB1.GRAPH1.LITICZ;
  17431. TITRE ' WALL TMAX CALCULATION ' ;
  17432. EVTIP = EVOL MANU MOTFLU LLLFLU 'TEMPERATURE' TAB1.GRAPH1.LITMP ;
  17433.  
  17434. L_SIGN1 = MOTS 'PLUS' 'CROI' 'ETOI' 'LOSA' 'TRIA' 'CARR' 'TRIB' 'PLUS' 'CROI' 'ETOI' 'LOSA' 'TRIA' 'CARR' 'TRIB' 'PLUS' 'CROI' 'ETOI' 'LOSA' 'TRIA' 'CARR' 'TRIB' 'PLUS' 'CROI' 'ETOI' 'LOSA' 'TRIA' 'CARR' 'TRIB';
  17435. *
  17436. * --- Trac\E9s de T en fonction du flux
  17437. *
  17438.  
  17439. EVTTTS1 = EVOL MANU ( PROG 0. ) ( PROG 0.) ;
  17440. MESS ' >>>@PPERM>>>> 5.0 ' ;
  17441. *
  17442. * --- boucle sur les points
  17443. *
  17444. TAC1 = TABLE ;
  17445. TAC1.TITRE = TABLE ;
  17446. IPP1 = 0 ;
  17447.  
  17448. si (existe TAB1 LI_POINT);
  17449. REPETER BOUPO5 (DIME TAB1.LI_POINT);
  17450. IPP1 = IPP1 + 1 ;
  17451. T_P1 = TEXT (EXTR IPP1 TAB1.LI_POINT);
  17452. T_P2 = EXTR IPP1 TAB1.LI_POINT;
  17453. *jb : 5 10 94 possibilite d'afficher la profondeur des TC
  17454. SI ( NON ( EXISTE TAB1 DEEPCA )) ;
  17455. TAB1.DEEPCA = FAUX ;
  17456. FINSI ;
  17457. SI TAB1.DEEPCA ;
  17458. D_TC = EXTR IPP1 TAB1.DEEPCALC ;
  17459. TITR 'C' T_P2 D_TC 'm' ;
  17460. SINON ;
  17461. TITR T_P2 'CALCULATION';
  17462. FINSI ;
  17463. *
  17464. SI ( IPP1 EGA 1 ) ;
  17465. EVTTTS1 = ( EVOL MANU MOTFLU LLLFLU 'TEMPERATURE' TAB1.LIS_TEMP.IPP1 );
  17466. SINON ;
  17467. EVTTTS1 = EVTTTS1 ET ( EVOL MANU MOTFLU LLLFLU 'TEMPERATURE' TAB1.LIS_TEMP.IPP1);
  17468. FINSI;
  17469. * TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1)' REGU ';
  17470. TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1);
  17471. FIN BOUPO5 ;
  17472. finsi ;
  17473. si (existe TAB1 POINTS);
  17474. REPETER BOUPO5 ;
  17475. IPP1 = IPP1 + 1 ;
  17476. si (existe ind1 &boupo5) ;
  17477. nom1 = ind1.&boupo5 ;
  17478. poa1 = tab1.points.nom1 ;
  17479. IPP1 = &boupo5 ;
  17480. SI ( NON ( EXISTE TAB1 DEEPCA )) ;
  17481. TAB1.DEEPCA = FAUX ;
  17482. FINSI ;
  17483. SI TAB1.DEEPCA ;
  17484. D_TC = EXTR IPP1 TAB1.DEEPCALC ;
  17485. TITR 'C' nom1 D_TC 'm' ;
  17486. SINON ;
  17487. TITR nom1 'CALCULATION';
  17488. FINSI ;
  17489. *
  17490. SI ( IPP1 EGA 1 ) ;
  17491. EVTTTS1 = ( EVOL MANU MOTFLU LLLFLU 'TEMPERATURE' TAB1.LIS_TEMP.IPP1 );
  17492. SINON ;
  17493. EVTTTS1 = EVTTTS1 ET ( EVOL MANU MOTFLU LLLFLU 'TEMPERATURE' TAB1.LIS_TEMP.IPP1);
  17494. FINSI;
  17495. TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1) ;
  17496. TAC1.TITRE.IPP1 = nom1 ;
  17497. sinon ;
  17498. quitter BOUPO5 ;
  17499. finsi ;
  17500. FIN BOUPO5 ;
  17501. finsi ;
  17502.  
  17503.  
  17504.  
  17505. IPP1 = IPP1 + 1;
  17506.  
  17507.  
  17508.  
  17509. TITR 'CALCUL SECTION TMAX' ;
  17510. EVTMCZ = EVOL MANU MOTFLU LLLFLU 'TEMPERATURE' TAB1.GRAPH1.LITMCZ ;
  17511. * TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1)
  17512. * ' REGU' ;
  17513. TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1) ;
  17514.  
  17515. MOTITR = TAB1.TITR_MAQ ;
  17516. TITRE MOTITR 'T-LOCAL' (TAB1.'T_LOCAL') 'V-LOCAL' (TAB1.'V_LOCAL') 'P-LOCAL' (TAB1.'P_LOCAL');
  17517. EVTTTS1 = EVTTTS1 ET EVTMCZ;
  17518. SI ((DIME TAB1.LIS_FLUX) >EG 2);
  17519.  
  17520. SI ( EXISTE TAB1 EVOTEST) ;
  17521. EVTTT = ( EVTTTS1 ET (TAB1 . EVOTEST) ) ;
  17522. REPETER BOUTA1 (DIME (TAB1 . EVOTEST) ) ;
  17523. IPP1 = IPP1 + 1;
  17524. TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1) ' NOLI' ;
  17525. FIN BOUTA1;
  17526. SINON ;
  17527. EVTTT = EVTTTS1 ;
  17528. FINSI ;
  17529. TAB1.EVORESU = EVTTTS1 ;
  17530. TAB1.EVTTT1 = EVTTT ;
  17531. DESSIN EVTTT LEGE MIMA TAC1 ;
  17532. *
  17533. * --- autres trac\E9s
  17534. *
  17535. TAC1 = TABLE ;
  17536. TAC1.TITRE = TABLE ;
  17537. IPP1 = 0 ;
  17538. SI ( EXISTE TAB1 EVEXP);
  17539. * TAB2 = INDEX TAB1.EVEXP ;
  17540. REPETER BOUPO8 (DIME TAB2);
  17541. IPP1 = IPP1 + 1 ;
  17542. * T_P2 = EXTR IPP1 TAB1.LI_THEB;
  17543. T_P2 = TAB2.IPP1 ;
  17544. TITRE TAB1.TITR_MAQ 'CORRELATION' TAB1.L_SUBNB ;
  17545. SI ( (DIME TAB1.LIS_FPAROI.IPP1) > 0);
  17546. II1 = 2*IPP1 - 1;
  17547. TAC1.II1 = CHAIN 'MARQ ' (EXTR L_SIGN1 II1) ' NOLI';
  17548. TAC1.TITRE.II1 = T_P2 'CALCULATION' ;
  17549. II1 = 2*IPP1 ;
  17550. TAC1.II1 = CHAIN 'MARQ ' (EXTR L_SIGN1 II1) ' NOLI';
  17551. TAC1.TITRE.II1 = T_P2 'EXP.' ;
  17552. SI ( IPP1 EGA 1 ) ;
  17553.  
  17554. EVDTFPA1 = ( EVOL MANU 'DTSAT' TAB1.LIS_DTPAROI.IPP1 'WALL_FLUX' TAB1.LIS_FPAROI . IPP1 ) ;
  17555. EVDTFPA1 = EVDTFPA1 ET ( EVOL MANU 'DTSAT' TAB1.LIS_DTEXP.IPP1 'WALL_FLUX' TAB1.LIS_FPAROI . IPP1 ) ;
  17556. SINON ;
  17557. EVDTFPA1 = EVDTFPA1 ET ( EVOL MANU 'DTSAT' TAB1.LIS_DTPAROI.IPP1 'WALL_FLUX' TAB1.LIS_FPAROI . IPP1 ) ;
  17558. EVDTFPA1 = EVDTFPA1 ET ( EVOL MANU 'DTSAT' TAB1.LIS_DTEXP.IPP1 'WALL_FLUX' TAB1.LIS_FPAROI . IPP1 ) ;
  17559. FINSI;
  17560. FINSI;
  17561. FIN BOUPO8 ;
  17562. list EVDTFPA1 ;
  17563. TITRE ' WALL_FLUX VERSUS DT_SAT' ;
  17564. DESS EVDTFPA1 LOGX LOGY LEGE MIMA TAC1 ;
  17565. FINSI ;
  17566. TAC3 = TABLE;
  17567. TAC3.1 = 'MARQ PLUS ' ;
  17568. TAC3.2 = 'MARQ ETOI ' ;
  17569. TAC3.3 = 'MARQ CROI ' ;
  17570. TITRE 'INC. POWER ';
  17571. EVPUII = EVOL MANU TAB1.GRAPH1.LIFL TAB1.GRAPH1.LIFLUP ;
  17572. TITRE 'CONVECTIVE POWER';
  17573. EVPUIC = EVOL MANU 'INC FLUX ' TAB1.GRAPH1.LIFL 'PUIS CONV ' TAB1.GRAPH1.LIFLUC ;
  17574. EVPOUIC = EVOL MANU 'INC FLUX ' TAB1.GRAPH1.LIFL '% PUIS CONV ' TAB1.GRAPH1.POFLUC ;
  17575. TITRE 'RADIATIVE POWER';
  17576. EVPUIR = EVOL MANU 'INC FLUX' TAB1.GRAPH1.LIFL 'PUIS RAYO ' TAB1.GRAPH1.LIFLUR ;
  17577. EVPOUIR = EVOL MANU 'INC FLUX' TAB1.GRAPH1.LIFL '% PUIS RAYO ' TAB1.GRAPH1.POFLUR ;
  17578. TITRE 'REPARTITION DES PUISSANCES ';
  17579. EVPUIS = (EVPUII ET EVPUIC ET EVPUIR) ;
  17580. DESSIN EVPUIS LEGE MIMA TAC3 ;
  17581. TITRE 'REPARTITION DES PUISSANCES EN %';
  17582. EVPOUIS = (EVPOUIC ET EVPOUIR) ;
  17583. DESSIN EVPOUIS LEGE MIMA TAC3 ;
  17584. *
  17585. TITRE 'CALC. WALL MAX FLUX';
  17586. EVFLUPAR = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'WALL FLUX' TAB1.GRAPH1.LIFLUM ;
  17587. TITRE 'EV.WALL FLUX(Fi*W/D)';
  17588. EVFLUEV = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'WALL FLUX' TAB1.GRAPH1.LIFLUEV ;
  17589. ICHOI = EXTR TAB1.'CHFCORRELATION' 1 ;
  17590. SI ( EGA ICHOI 'TONG' ) ;
  17591. TITRE TAB1. M_TONG ;
  17592. FINSI ;
  17593. SI ( EGA ICHOI 'CELA' ) ;
  17594. TITRE 'CELATA 94' ;
  17595. FINSI ;
  17596. EVFLCRIT = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'WALL FLUX' TAB1.GRAPH1.FLUCRIT ;
  17597. *jb
  17598. SI TAB1.M_TONGJB ;
  17599. TITRE '1.67*TONG75 CHF ';
  17600. EVFLCRIT = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFLU 'WALL FLUX' TAB1.GRAPH1.FLUCRIT ;
  17601. TITRE (CHAIN (EXTR TAB1.CHFCORRELATION 1) ' CHF ');
  17602. EVFLJB = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFLU 'WALL. FLUX' TAB1.GRAPH1.FLUCRITJB ;
  17603. FINSI ;
  17604. *
  17605. TITRE 'TEST CHF ';
  17606. SI ( EXISTE TAB1 EVOTEST ) ;
  17607. M_FIESS = MAXI ( TAB1.EVOTEST EXTR 'ABSC' ) ;
  17608. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  17609. M_FWESS = M_FIESS * (TAB1.W_HEATED) / TAB1.DH ;
  17610. SINON ;
  17611. M_FWESS = M_FIESS * (TAB1.W_HEATED) / TAB1.D_MAQUETTE ;
  17612. FINSI ;
  17613. EVFCESS = EVOL MANU 'INC. FLUX' ( PROG M_FIESS ) 'WALL FLUX' ( PROG M_FWESS ) ;
  17614. TITRE MOTITR 'T-LOCAL' (TAB1.'T_LOCAL') 'V-LOCAL' (TAB1.'V_LOCAL') 'P-LOCAL' (TAB1.'P_LOCAL');
  17615.  
  17616.  
  17617. TAC3.4 = 'MARQ TRIB REGU' ;
  17618. *jb
  17619. SI TAB1.M_TONGJB ;
  17620. TAC3.5 = 'MARQ CARR NOLI' ;
  17621. DESSIN ( EVFLUPAR ET EVFLUEV ET EVFLJB ET EVFLCRIT ET EVFCESS )LEGE MIMA TAC3 ;
  17622. *jb
  17623. TAB1.EVFLUPA1 = EVFLUPAR ;
  17624. TAB1.EVFLUE1 = EVFLUEV ;
  17625. TAB1.EVFLJ1 = EVFLJB ;
  17626. TAB1.EVFLCRI1 = EVFLCRIT ;
  17627. TAB1.EVFCES1 = EVFCESS ;
  17628. SINON ;
  17629. DESSIN (EVFLUPAR ET EVFLUEV ET EVFLCRIT ET EVFCESS) LEGE MIMA TAC3 ;
  17630. TAB1.EVFLUPA1 = EVFLUPAR ;
  17631. TAB1.EVFLUE1 = EVFLUEV ;
  17632. TAB1.EVFLCRI1 = EVFLCRIT ;
  17633. TAB1.EVFCES1 = EVFCESS ;
  17634. FINSI ;
  17635. SINON ;
  17636. SI TAB1.M_TONGJB ;
  17637. DESSIN ( EVFLUPAR ET EVFLUEV ET EVFLJB ET EVFLCRIT ET EVFCESS )LEGE MIMA TAC3 ;
  17638. TAB1.EVFLUPA1 = EVFLUPAR ;
  17639. TAB1.EVFLUE1 = EVFLUEV ;
  17640. TAB1.EVFLJ1 = EVFLJB ;
  17641. TAB1.EVFLCRI1 = EVFLCRIT ;
  17642. TAB1.EVFCES1 = EVFCESS ;
  17643. SINON;
  17644. DESSIN ( EVFLUPAR ET EVFLUEV ET EVFLCRIT ) LEGE MIMA TAC3 ;
  17645. TAB1.EVFLUPA1 = EVFLUPAR ;
  17646. TAB1.EVFLUE1 = EVFLUEV ;
  17647. TAB1.EVFLCRI1 = EVFLCRIT ;
  17648. TAB1.EVFCES1 = EVFCESS ;
  17649. FINSI ;
  17650. FINSI ;
  17651. TITRE 'W/D P.F.';
  17652. TAC3.1 = 'MARQ PLUS ' ;
  17653. TAC3.2 = 'MARQ ETOI ' ;
  17654. TAC3.3 = 'MARQ CROI ' ;
  17655. TAC3.4 = 'MARQ TRIA ' ;
  17656. TAC3.5 = 'MARQ TRIB ' ;
  17657.  
  17658. EGEOPF = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'PEAKING_FACTOR' (TAB1.GRAPH1.LIFLUEV / TAB1.GRAPH1.LIFLU);
  17659. TITRE 'MAX FE P.F.';
  17660. EMEFPF = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'PEAKING_FACTOR' (TAB1.GRAPH1.LIFLUM / TAB1.GRAPH1.LIFLU);
  17661. TAB1.FE_PF = EMEFPF ;
  17662. SI TAB1.LCAPKPC;
  17663. TITRE '90% FE P.F.';
  17664. E90PF = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'PEAKING_FACTOR' TAB1.GRAPH1.L90PF;
  17665. TITRE '80% FE P.F.';
  17666. E80PF = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'PEAKING_FACTOR' TAB1.GRAPH1.L80PF;
  17667. TITRE '70% FE P.F.';
  17668. E70PF = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'PEAKING_FACTOR' TAB1.GRAPH1.L70PF;
  17669. TITRE MOTITR 'T-LOCAL' (TAB1.'T_LOCAL') 'V-LOCAL' (TAB1.'V_LOCAL') 'P-LOCAL' (TAB1.'P_LOCAL');
  17670. DESSIN (E70PF ET E80PF ET E90PF ET EMEFPF ET EGEOPF) LEGE MIMA TAC3;
  17671. SINON ;
  17672. DESSIN ( EMEFPF ET EGEOPF) LEGE MIMA TAC3;
  17673. FINSI ;
  17674. *jb
  17675. TAB1.EMEFP1 = EMEFPF ;
  17676. TAB1.EGEOP1 = EGEOPF ;
  17677. FINSI ;
  17678. FINSI ;
  17679. TAB1.PPRLI1 = PRLI1 ;
  17680. MENAGE;
  17681. SI (NIVEAU >EG 4) ;
  17682. MESS ' -------------------> exiting @PPERM';
  17683. FINSI ;
  17684. FINPROC;
  17685. DEBPROC PRINRAPH CONTR1*MCHAML MOD1*MMODEL MAIL1/MAILLAGE ;
  17686.  
  17687. MESS '-----------------------------------> entree dans PRINRAPH ' ;
  17688. * modifier de maniere a pouvoir entre en option
  17689. *- le maillage sur lequel on veut les contraintes principales
  17690. *- le maillage sur lequel on veut que seffectue le trace
  17691. *
  17692. *
  17693.  
  17694. DIM1 = VALEUR DIME ;
  17695. * test sur la dimension
  17696. SI (EGA DIM1 2) ;
  17697. ;
  17698. SINON ;
  17699. ERRE 'PRIN RAPH NE MARCHE QUE EN 2D';
  17700. FINSI;
  17701.  
  17702.  
  17703.  
  17704.  
  17705.  
  17706. * de toute facon, il faut depouiller objet modele apres objet modele
  17707. * sinon, plusieurs contraintes principales n'ont pas de sens.
  17708.  
  17709. CONTR2 = REDU CONTR1 MOD1 ;
  17710. CONTR1 = CONTR2 ;
  17711. CPRIN1 = PRIN CONTR1 MOD1 ;
  17712. STOT1 = EXTR MOD1 'MAIL' ;
  17713. * on peut depouiller en modulant la taille du vecteur par
  17714. * le module de la contrainte principale associee
  17715.  
  17716. *----------1
  17717. * on extrait les composantes de module et de cos directeurs
  17718. CHSI11 = EXCO CPRIN1 SI11 ;
  17719. CHCOX1 = EXCO CPRIN1 COX1 ;
  17720. CHCOY1 = EXCO CPRIN1 COY1 ;
  17721. CHCOZ1 = EXCO CPRIN1 COZ1 ;
  17722. CHSI22 = EXCO CPRIN1 SI22 ;
  17723. CHCOX2 = EXCO CPRIN1 COX2 ;
  17724. CHCOY2 = EXCO CPRIN1 COY2 ;
  17725. CHCOZ2 = EXCO CPRIN1 COZ2 ;
  17726.  
  17727. *on transforme les composantes en champs par point
  17728. CKSI11 = CHAN CHPO MOD1 CHSI11 ;
  17729. CKCOX1 = CHAN CHPO MOD1 CHCOX1 ;
  17730. CKCOY1 = CHAN CHPO MOD1 CHCOY1 ;
  17731. CKCOZ1 = CHAN CHPO MOD1 CHCOZ1 ;
  17732. CKSI22 = CHAN CHPO MOD1 CHSI22 ;
  17733. CKCOX2 = CHAN CHPO MOD1 CHCOX2 ;
  17734. CKCOY2 = CHAN CHPO MOD1 CHCOY2 ;
  17735. CKCOZ2 = CHAN CHPO MOD1 CHCOZ2 ;
  17736.  
  17737. *on renomme correctement les composantes
  17738. CLSI11 = NOMC SCAL CKSI11 ;
  17739. CLCOX1 = NOMC UX CKCOX1 ;
  17740. CLCOY1 = NOMC UY CKCOY1 ;
  17741. CLCOZ1 = NOMC UZ CKCOZ1 ;
  17742.  
  17743. CLSI22 = NOMC SCAL CKSI22 ;
  17744. CLCOX2 = NOMC UX CKCOX2 ;
  17745. CLCOY2 = NOMC UY CKCOY2 ;
  17746. CLCOZ2 = NOMC UZ CKCOZ2 ;
  17747.  
  17748. *CLSI11_P = CLSI11 * ( CLSI11 MASQUE SUPERIEUR 0. );
  17749. *CLSI11_N = CLSI11 * ( CLSI11 MASQUE INFERIEUR 0. );
  17750. *CLSI22_P = CLSI22 * ( CLSI22 MASQUE SUPERIEUR 0. );
  17751. *CLSI22_N = CLSI22 * ( CLSI22 MASQUE INFERIEUR 0. );
  17752. CLSI11_P = CLSI11 MASQUE SUPERIEUR 0. ;
  17753. CLSI11_N = CLSI11 MASQUE INFERIEUR 0. ;
  17754. CLSI22_P = CLSI22 MASQUE SUPERIEUR 0. ;
  17755. CLSI22_N = CLSI22 MASQUE INFERIEUR 0. ;
  17756.  
  17757. *on multiplie les cosinus directeurs par la norme -1 ou +1
  17758.  
  17759. CMCOX1P = CLSI11_P * CLCOX1 ;
  17760. CMCOY1P = CLSI11_P * CLCOY1 ;
  17761. CMCOZ1P = CLSI11_P * CLCOZ1 ;
  17762.  
  17763. CMCOX1N = CLSI11_N * CLCOX1 ;
  17764. CMCOY1N = CLSI11_N * CLCOY1 ;
  17765. CMCOZ1N = CLSI11_N * CLCOZ1 ;
  17766.  
  17767. CMCOX2P = CLSI22_P * CLCOX2 ;
  17768. CMCOY2P = CLSI22_P * CLCOY2 ;
  17769. CMCOZ2P = CLSI22_P * CLCOZ2 ;
  17770.  
  17771. CMCOX2N = CLSI22_N * CLCOX2 ;
  17772. CMCOY2N = CLSI22_N * CLCOY2 ;
  17773. CMCOZ2N = CLSI22_N * CLCOZ2 ;
  17774.  
  17775.  
  17776. * on cree des champs par point contenat toutes les composantes
  17777. CH1P = CMCOX1P + CMCOY1P + CMCOZ1P ;
  17778. CH1N = CMCOX1N + CMCOY1N + CMCOZ1N ;
  17779. CH2P = CMCOX2P + CMCOY2P + CMCOZ2P ;
  17780. CH2N = CMCOX2N + CMCOY2N + CMCOZ2N ;
  17781.  
  17782.  
  17783. * on cree le champs de vecteurs
  17784. COEF1 = 2.E-11 ;
  17785. COEF1 = .00017 ;
  17786. VVEC1P = VECT CH1P COEF1 'UX' 'UY' ROUGE ;
  17787. VVEC1N = VECT CH1N COEF1 'UX' 'UY' VERT ;
  17788. VVEC2P = VECT CH2P COEF1 'UX' 'UY' ROUGE ;
  17789. VVEC2N = VECT CH2N COEF1 'UX' 'UY' VERT ;
  17790. WVEC1P = VECT (-1. * CH1P) COEF1 'UX' 'UY' ROUGE ;
  17791. WVEC1N = VECT (-1. * CH1N) COEF1 'UX' 'UY' VERT ;
  17792. WVEC2P = VECT (-1. * CH2P) COEF1 'UX' 'UY' ROUGE ;
  17793. WVEC2N = VECT (-1. * CH2N) COEF1 'UX' 'UY' VERT ;
  17794.  
  17795.  
  17796. SI (EXISTE MAIL1 ) ;
  17797. TRAC (VVEC1P ET VVEC1N ET WVEC1P ET WVEC1N ET VVEC2P ET VVEC2N ET WVEC2P ET WVEC2N) MAIL1 ;
  17798. SINON ;
  17799. TRAC (VVEC1P ET VVEC1N ET WVEC1P ET WVEC1N ET VVEC2P ET VVEC2N ET WVEC2P ET WVEC2N) STOT1 ;
  17800. FINSI ;
  17801.  
  17802.  
  17803.  
  17804. * maintenant , on peut diminuer la quantite d'information en
  17805. * ne donnant que les directions
  17806.  
  17807. *CH1 = CLCOX1 + CLCOY1 + CLCOZ1 ;
  17808. *CH2 = CLCOX2 + CLCOY2 + CLCOZ2 ;
  17809.  
  17810. *VVEC1 = VECT CH1 .00015 'UX' 'UY' TURQ ;
  17811. *VVEC2 = VECT CH2 .00015 'UX' 'UY' TURQ ;
  17812. *VVEC3 = VECT (-1. * CH1) .00015 'UX' 'UY' TURQ ;
  17813. *VVEC4 = VECT (-1. * CH2) .00015 'UX' 'UY' TURQ ;
  17814.  
  17815.  
  17816. *TRAC (VVEC1 ET VVEC2 ET VVEC3 ET VVEC4) CON3 ;
  17817. *TRAC (VVEC1 ET VVEC3) CON3 ;
  17818. *TRAC (VVEC2 ET VVEC4) CON3 ;
  17819.  
  17820.  
  17821.  
  17822. MESS '-----------------------------------> sortie de PRINRAPH ' ;
  17823. FINPROC ;
  17824.  
  17825.  
  17826. **** @PTRANS
  17827. 'DEBPROC' @PTRANS TAB1*'TABLE' ;
  17828. SI (NON (EXISTE TAB1 NISOV)) ;
  17829. TAB1.NISOV = 7 ;
  17830. FINSI ;
  17831. MESS '>PTRANS TAB1.NISOV' TAB1.NISOV ;
  17832. NIVEAU = TAB1.'NIVEAU' ;
  17833. SI (NIVEAU >EG 4 ) ;
  17834. MESS '---------------------------------> calling @PTRANS';
  17835. FINSI ;
  17836. ICORSA1 = 0 ;
  17837. IVALI1 = 1 ;
  17838. SI ( NON (EXISTE TAB1 VIEW_P )) ;
  17839. TAB1.VIEW_P = TEXT ' ' ;
  17840. TEX2 = TEXT ' ' ;
  17841. SI ( EGA ( VALE DIME) 3 ) ;
  17842. TAB1.VIEW_P = 1.E8 -1.E8 1.E8 ;
  17843. FINSI ;
  17844. FINSI ;
  17845. C_ONT1 = TAB1.M_IL_CONTOUR ;
  17846. S_TOT1 = TAB1.M_ILLAGE_TOT ;
  17847. *VIN = TAB1 . V_IN RM 23.01.96 ;
  17848. VIN = TAB1.V_LOCAL ;
  17849. TIN = TAB1 . T_IN ;
  17850. PIN = TAB1 . P_IN ;
  17851. TTAPE = TAB1 . T_TAPE ;
  17852. YTWIST = TAB1 . TWIST_RATIO ;
  17853. LAMBDA = TAB1 . 'LAMBDA' ;
  17854. AMPLV1 = ( TAB1 . D_MAQUETTE ) / ( 2. * TAB1.MAX_SOFL ) ;
  17855. VPAT1 = TAB1.V_VPAT1 ;
  17856. FLUMOY1 = TAB1.V_FLUMOY1 ;
  17857. COTETF1 = TAB1.C_COTETF1 ;
  17858. SITETF1 = TAB1.C_SITETF1 ;
  17859. COTETR1 = TAB1.C_COTETR1 ;
  17860. SITETR1 = TAB1.C_SITETR1 ;
  17861. COTETC1 = TAB1.C_COTETC1 ;
  17862. SITETC1 = TAB1.C_SITETC1 ;
  17863. TAC8 = TABLE TAB1.T_TAC8 ;
  17864. TAC2 = TABLE ;
  17865. TAC2.1 = 'MARQ CROI REGU TITRE INC_POWER' ;
  17866. TAC2.2 = 'MARQ PLUS REGU TITRE RAD_POWER' ;
  17867. TAC2.3 = 'MARQ LOSA REGU TITRE CONV_POWER' ;
  17868. *RM011098
  17869. si (existe tab1 points) ;
  17870. ind1 = inde (tab1.points) ;
  17871. finsi ;
  17872.  
  17873.  
  17874.  
  17875. * on est dans @ptrans *********************************************
  17876. SI ( TAB1.TRANSITOIRE ) ;
  17877. * TEMPS ;
  17878. * MESS '>>>>> 4.10 >>>>>>' ;
  17879. VFPAT1 = TAB1.V_VPAT1 * (EXTR TAB1.LIS_FLUX ( DIME TAB1.LIS_FLUX ));
  17880. PHIZERO = (EXTR TAB1.LIS_FLUX ( DIME TAB1.LIS_FLUX ));
  17881. SI ( EXISTE TAB1 'LAMDAQ' ) ;
  17882. SI ( EXISTE TAB1 'CENTRE_PLASMA' ) ;
  17883. PUI1 = TAB1.V_FLUMOY1 * (TAB1 . B_HEATED) * (TAB1.WE_HEATED ) ;
  17884. SINON ;
  17885. PUI1 = TAB1.V_FLUMOY1 * (TAB1 . L_HEATED) * (TAB1.WE_HEATED ) ;
  17886. FINSI ;
  17887. SINON ;
  17888. PUI1 = TAB1.V_FLUMOY1 * (TAB1 . L_HEATED) * (TAB1.W_HEATED ) ;
  17889. FINSI;
  17890. * TMOY = TAB1.'TETA' ;
  17891. IFIG = 0 ;
  17892. IFIG = IFIG + 1 ;
  17893. TITRE '-p' IFIG '-BILAN DES PUIS.' PHIZERO ;
  17894.  
  17895. DESSIN ( ( TAB1.'EFLUI' ) ET ( TAB1.'EFLUR' ) ET ( TAB1.'EFLUC' ) ) LEGE TAC2 ;
  17896. *tc ajout d'un finsi au pif!!!!!!!!!!
  17897. 'FINSI';
  17898. *
  17899. *
  17900. si (existe tab1 LI_POINT) ;
  17901. TAB1.LIS_TEMP = TABLE ;
  17902. IPP1 = 0 ;
  17903. REPETER BOUPO6 ((DIME TAB1.LI_POINT) + 1 );
  17904. TAB1.LIS_TEMP . IPP1 = PROG;
  17905. IPP1 = IPP1 + 1 ;
  17906. FIN BOUPO6;
  17907. finsi ;
  17908.  
  17909. si (existe tab1 points) ;
  17910. TAB1.LIS_TEMP = TABLE ;
  17911. TAB1.LIS_TEMP . 0. = PROG;
  17912. REPETER BOUPO6 ;
  17913. si (exis ind1 &BOUPO6) ;
  17914. TAB1.LIS_TEMP . &BOUPO6 = PROG;
  17915. sinon ;
  17916. quitter BOUPO6 ;
  17917. finsi ;
  17918. FIN BOUPO6;
  17919. finsi ;
  17920.  
  17921. I_0 = -1 ;
  17922. I_1 = I_0 ;
  17923. LSORT1 = TAB1 .LI_SORT1 ;
  17924. LSORT2 = TAB1 .LI_SORT2 ;
  17925. SI ( NON (EXISTE TAB1 OPT_SORT2) ) ;
  17926. TAB1.OPT_SORT2 = MOT ' ' ;
  17927. FINSI ;
  17928. EVTRT = EVOL MANU ( PROG ) ( PROG ) ;
  17929. PTT1 = PROG ;
  17930. II2 = 0 ;
  17931. EVTTR1 = EVOL MANU ( PROG 0. ) ( PROG 0. ) ;
  17932. TAC4 = TABLE ;
  17933. ROUGE = MOT ' ' ;
  17934. * TAC4.1 = 'MARQ CROI REGU TITRE ROUGE' ;
  17935. TAC4.2 = 'MARQ PLUS REGU ' ;
  17936. TAC4.3 = 'MARQ PLUS REGU ' ;
  17937. TAC4.4 = 'MARQ ETOI REGU ' ;
  17938. TAC4.5 = 'MARQ ETOI REGU ' ;
  17939. TAC4.6 = 'MARQ CARR REGU ' ;
  17940. TAC4.7 = 'MARQ CARR REGU ' ;
  17941. TAC4.8 = 'MARQ LOSA REGU ' ;
  17942. TAC4.9 = 'MARQ LOSA REGU ' ;
  17943. TAC4.10 = 'MARQ TRIA REGU ' ;
  17944. TAC4.11 = 'MARQ TRIA REGU ' ;
  17945. TAC4.12 = 'MARQ TRIB REGU ' ;
  17946. TAC4.13 = 'MARQ TRIB REGU ' ;
  17947. TAC4.14 = 'MARQ CROI REGU ' ;
  17948. TAC4.15 = 'MARQ CROI REGU ' ;
  17949. TAC4.16 = 'MARQ PLUS REGU ' ;
  17950. TAC4.17 = 'MARQ PLUS REGU ' ;
  17951. TAC4.18 = 'MARQ ETOI REGU ' ;
  17952. TAC4.19 = 'MARQ ETOI REGU ' ;
  17953. TAC4.20 = 'MARQ CARR REGU ' ;
  17954. TAC4.21 = 'MARQ CARR REGU ' ;
  17955. TAC4.22 = 'MARQ LOSA REGU ' ;
  17956. TAC4.23 = 'MARQ LOSA REGU ' ;
  17957. TAC4.24 = 'MARQ TRIA REGU ' ;
  17958. TAC4.25 = 'MARQ TRIA REGU ' ;
  17959. TAC4.26 = 'MARQ TRIB REGU ' ;
  17960. TAC4.27 = 'MARQ TRIB REGU ' ;
  17961. TAC4.28 = 'MARQ PLUS REGU ' ;
  17962. REPETER BEXP1 ;
  17963. I_1 = I_1 + 1 ;
  17964. * MESS ' exploitation pas ' I_1 ;
  17965. SI ( NON ( EXISTE TAB1 I_1 ) ) ;
  17966. QUITTER BEXP1 ;
  17967. FINSI ;
  17968. *
  17969. *--- EXTRACTION DES TEMP. AUX PTS DESIRES
  17970. *
  17971. * les 10 lignes suivantes sont assez d\E9licates
  17972. * svp ne pas modifier sans l'avis de RM ou JS
  17973. TE1 = EXCO 'T' ( TAB1. I_1 . TEMPERATURE ) ;
  17974. TT1 = TAB1. I_1 . 'INSTANT' ;
  17975. PTT1 = PTT1 ET ( PROG TT1 ) ;
  17976. IPP1 = 0 ;
  17977.  
  17978. SI ( EXISTE TAB1 LI_POINT ) ;
  17979. REPETER BOUPO7 ( DIME TAB1.LI_POINT) ;
  17980. IPP1 = IPP1 + 1 ;
  17981. * rm 10/09/96 T_P1 = TEXT (EXTR IPP1 TAB1.LI_POINT);
  17982. T_P1 = text ('EXTR' IPP1 TAB1.LI_POINT) ;
  17983. * list (TYPE (T_P1)) ;
  17984. SI (EGA T_P1 '_MAX') ;
  17985. TMIP1 = MAXI TE1 ;
  17986. SINON ;
  17987. T_P3 = S_TOT1 'POIN' 'PROC' (T_P1) ;
  17988. TMIP1 = EXTR ( TAB1. I_1. TEMPERATURE ) 'T' T_P3;
  17989. FINSI ;
  17990. TAB1.LIS_TEMP . IPP1 = ( TAB1.LIS_TEMP . IPP1 ) ET ( PROG TMIP1 ) ;
  17991. FIN BOUPO7 ;
  17992. FINSI ;
  17993. * autre syntaxe pour le meme resultat, RM011098
  17994. si (existe tab1 points) ;
  17995. repe boupo7 ;
  17996. si (existe ind1 &boupo7) ;
  17997. nom1 = ind1.&boupo7 ;
  17998. poa1 = tab1.points.nom1 ;
  17999. si (ega nom1 '_max');
  18000. tmip1 = maxi te1 ;
  18001. sinon ;
  18002. tmip1 = extr ( tab1. i_1. temperature ) 'T' poa1;
  18003. finsi ;
  18004. TAB1.LIS_TEMP . &boupo7 = ( TAB1.LIS_TEMP . &boupo7 ) ET ( PROG TMIP1 ) ;
  18005. sinon ;
  18006. quitter boupo7 ;
  18007. finsi ;
  18008. fin boupo7;
  18009. finsi ;
  18010. ISORT1 = 0 ;
  18011. IS1 = 0 ;
  18012. REPETER BEXP2 ( DIME LSORT1 ) ;
  18013. IS1 = IS1 + 1 ;
  18014. TS1 = EXTR LSORT1 IS1 ;
  18015. SI ( TT1 EGA TS1 1.E-3 )  ;
  18016. ISORT1 = 1 ;
  18017. QUITTER BEXP2  ;
  18018. FINSI ;
  18019. FIN BEXP2 ;
  18020. ISORT2 = 0 ;
  18021. IS2 = 0 ;
  18022.  
  18023. REPETER BEXP3 ( DIME LSORT2 ) ;
  18024. IS2 = IS2 + 1 ;
  18025. TS2 = EXTR LSORT2 IS2 ;
  18026. SI ( TT1 EGA TS2 1.E-3 ) ;
  18027. ISORT2 = 1 ;
  18028. QUITTER BEXP3 ;
  18029. FINSI ;
  18030. FIN BEXP3 ;
  18031. *
  18032. SI ( ISORT1 EGA 1 ) ;
  18033. *
  18034. FCOEF = IPOL TT1 (TAB1.'PTF1') (TAB1.'PCF1') ;
  18035. CHPX = EXCO SCAL ( VFPAT1 * ( COTETF1 ) ) UX ;
  18036. CHPY = EXCO SCAL ( VFPAT1 * ( SITETF1 ) ) UY ;
  18037. CHPT2 = @ET CHPX CHPY ;
  18038. * changement de couleur possible des fleches du flux a la paroi
  18039. ROUGE = 'ROUGE';
  18040. VEC_22 = @VECADA CHPT2 ( FCOEF * -1. * AMPLV1 ) ROUGE ;
  18041.  
  18042. TAB1. V_VEC22 = VEC_22 ;
  18043. SI ( EGA I_1 0 ) ;
  18044. HCONVT1 = HCON1 ;
  18045. SINON ;
  18046. HCONVT1 = EXCO 'H' ( TAB1. I_1 . COEFHCONV ) ;
  18047. FINSI ;
  18048. TECA0 = ( REDU TE1 TAB1.LFLUX_CONV ) ;
  18049. FCNV2 = ( TECA0 - TAB1.'TETA' ) * HCONVT1 ;
  18050. CHPCX = EXCO SCAL ( FCNV2 * ( COTETC1 ) ) UX ;
  18051. CHPCY = EXCO SCAL ( FCNV2 * ( SITETC1 ) ) UY ;
  18052. CHPCT = ( CHPCX @ET CHPCY ) ;
  18053. VEC_1 = @VECADA CHPCT ( 1. * AMPLV1 ) ROUGE ;
  18054. TAB1. V_VEC1 = VEC_1 ;
  18055. *
  18056. * trace sur le meme graphe des conditions thermohydrauliques a la paroi
  18057. * FLUX/1.E6, Temperatures/10.
  18058. *
  18059. TITRE '-p' IFIG '- TIME AND PHI0 ' TT1 ( PHIZERO * FCOEF ) ;
  18060. FLUITT1 = TAB1.V_FLUMOY1 * FCOEF ;
  18061. LMARQ1 = MOTS 'LOSA' 'TRIA' 'TRIB' 'LOSA' 'TRIA' 'TRIB' ;
  18062. TAC2 = TABLE ;
  18063. TAC2.1 = 'MARQ CARR REGU TITRE WALL_FLUX' ;
  18064. EVFLC1 = EVOL VERT 'CHPO' (FCNV2/1.E6) SCAL TAB1.LFLUX_CONV_DESS;
  18065. PLINT1 = EXTR EVFLC1 ABSC 1 ;
  18066. EVETOT1 = EVFLC1 ;
  18067.  
  18068. NB_FLUX = DIME TAB1.'L_QCHFW' ;
  18069. I1 = 0 ;
  18070. REPETER BOUC_CHF NB_FLUX ;
  18071. I1 = I1 + 1 ;
  18072. EVQCRI1 = EVOL VERT MANU PLINT1 (PROG (DIME PLINT1) * ((EXTR TAB1.'L_QCHFW' I1)/1.E6)) ;
  18073. EVETOT1 = EVETOT1 ET EVQCRI1 ;
  18074. SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'TONG') ;
  18075. NOM_CORR = TAB1.M_TONG ;
  18076. FINSI ;
  18077. SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'BOWR') ;
  18078. NOM_CORR = 'BOWRING72' ;
  18079. FINSI ;
  18080. SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'CELA') ;
  18081. NOM_CORR = 'CELATA94' ;
  18082. FINSI ;
  18083. TAC2.(I1 + 1 ) = CHAIN 'MARQ ' (EXTR LMARQ1 I1) ' REGU TITRE ' NOM_CORR ;
  18084. FIN BOUC_CHF ;
  18085.  
  18086. EVTC1 = EVOL ROUG 'CHPO' (TECA0/10.) SCAL TAB1.LFLUX_CONV_DESS ;
  18087. TAC2.(2 + I1 ) = 'MARQ CROI REGU TITRE WALL_TEMP' ;
  18088. EVETOT1 = EVETOT1 ET EVTC1 ;
  18089.  
  18090. EVTONB = EVOL ROUG MANU PLINT1 (PROG (DIME PLINT1) * (TAB1.V_TONB /10. )) ;
  18091. TAC2.(3 + I1) = 'MARQ ETOI REGU TITRE TONB' ;
  18092. EVETOT1 = EVETOT1 ET EVTONB ;
  18093.  
  18094. MESS '>@PTRANS> THERMOHYDRAULICS AT T = ' TT1 ;
  18095. DESSIN EVETOT1 LEGE MIMA TAC2 ;
  18096.  
  18097. SI ( EXISTE TAB1 LFLUX_RAYO ) ;
  18098. HRAYOT1 = EXCO 'H' ( TAB1. I_1 . COEFHRAYO ) ;
  18099. TERA1 = ( REDU TE1 (TAB1 . LFLUX_RAYO) ) ;
  18100. FRAY2 = HRAYOT1 * ( TERA1 - (TAB1 . TEMP_RAYO)) ;
  18101. CHPRX = EXCO SCAL ( FRAY2 * ( COTETR1 ) ) UX ;
  18102. CHPRY = EXCO SCAL ( FRAY2 * ( SITETR1 ) ) UY ;
  18103. CHPRT = ( CHPRX @ET CHPRY ) ;
  18104. *>>>>>>>> modif bonnefoi du 6/04/93
  18105. * VER1 = VECT CHPRT ( AMPLV1 ) UX UY ROUG ;
  18106. VER1 = @VECADA CHPRT ( AMPLV1 ) ROUG ;
  18107. TAB1. V_VER1 = VER1 ;
  18108. EVTR1 = EVOL 'CHPO' ( TERA1 * 1.E5 ) SCAL (TAB1 . LFLUX_RAYO_DESS);
  18109. EVFLR1 = EVOL 'CHPO' FRAY2 SCAL (TAB1 . LFLUX_RAYO_DESS) ;
  18110. TITRE '-p'IFIG '- EXT. SURF. T. PROFILE ' TT1 ( PHIZERO * FCOEF );
  18111. TAC2.1 = 'MARQ CROI REGU TITRE RADIATIVE_FLUX' ;
  18112. *js 050997 TAC2.3 = 'MARQ CARR REGU TITRE L_RAYO_TEMP' ;
  18113. TAC2.2 = 'MARQ CARR REGU TITRE L_RAYO_TEMP' ;
  18114. MESS '>@PTRANS> 32.1 ' ;
  18115. DESSIN (EVFLR1 ET EVTR1 ) LEGE MIMA TAC2 ;
  18116. FINSI ;
  18117. TITRE '-p' IFIG '- ISOV. TEMP.' TT1 ( PHIZERO * FCOEF ) ;
  18118. * TRACER TAB1.VIEW_P CACH
  18119. * ( TAB1. I_1 . TEMPERATURE ) S_TOT1 C_ONT1;
  18120. MESS '>@PTRANS> TEMP ISOVALUES AT T = ' TT1 ;
  18121. *>>>>>modif J.F. Salavy le 04/05/95 : ajout de la possibilite de
  18122. *>>>>>tracer avec echelle constante au cours du temps. Cette echelle
  18123. *>>>>>TAB1.LECHTR est une prog de 14 valeurs definie dans le jeu de
  18124. *>>>>>donnees en fonction de Tmin et Tmax
  18125. SI ( EXISTE TAB1 LECHTR ) ;
  18126. MESS '>PTRANS 33.0>>>' ;
  18127. TRACER TAB1.LECHTR TAB1.VIEW_P CACH ( TAB1. I_1 . TEMPERATURE ) S_TOT1 C_ONT1 ( VEC_1 ET VER1 ET VEC_22 ) ;
  18128. SINON ;
  18129. MESS '>PTRANS 33.1>>>' ;
  18130. TRACER CACH TAB1.VIEW_P TAB1.NISOV ( TAB1. I_1 . TEMPERATURE ) S_TOT1 C_ONT1 ( VEC_1 ET VER1 ET VEC_22 ) ;
  18131. FINSI ;
  18132. SI ( EXISTE TAB1 VIEW_P2 ) ;
  18133. MESS '>PTRANS 33.2>>>' ;
  18134. TRAC CACH TAB1.VIEW_P2 TAB1.NISOV ( TAB1. I_1 . TEMPERATURE ) S_TOT1 C_ONT1 ( VEC_1 ET VER1 ET VEC_22 ) ;
  18135. FINSI ;
  18136. FINSI ;
  18137. SI ( ISORT2 EGA 1 ) ;
  18138. II2 = II2 + 1 ;
  18139. *js 050997 II21 = II2 * 2 - 1 + 1 ;
  18140. II21 = II2 ;
  18141. MESS '>@PTRANS> RAD,TEMP PROFILE AT T = ' TT1 II2 II21 ;
  18142. *
  18143. FCOEF = IPOL TT1 (TAB1.'PTF1') (TAB1.'PCF1') ;
  18144. *
  18145. SI ( EXISTE TAB1 LFLUX_RAYO ) ;
  18146. TITRE 'TIME' TT1 IFIG '- EXT. SURF. PROFILE ' ( PHIZERO * FCOEF );
  18147. TERA1 = ( REDU TE1 (TAB1 . LFLUX_RAYO) ) ;
  18148. EVTR1 = EVOL 'CHPO' ( TERA1 ) SCAL (TAB1 . LFLUX_RAYO_DESS);
  18149. EVTTR1 = EVTTR1 ET EVTR1 ;
  18150. SI ( EXISTE TAC4 II21 ) ;
  18151. TAC4.II21 = CHAINE TAC4.II21 ' TITRE ' TT1 ;
  18152. FINSI ;
  18153. * DESSIN EVTTR1 LEGE MIMA TAC4 ;
  18154. FINSI ;
  18155. FINSI ;
  18156. FIN BEXP1 ;
  18157. MESS ' end of the loop on the time to process ' ;
  18158. TTTTT1 = TEXT 'DESSIN EVTTR1 ' (TAB1.OPT_SORT2) 'LEGE MIMA TAC4 ' ;
  18159. TTTTT1 ;
  18160. * DESSIN EVTTR1 (TAB1.OPT_SORT2) LEGE MIMA TAC4 ;
  18161. *
  18162. TITRE '-P' IFIG '- EVOL. T. SURF.' PHIZERO ;
  18163. IPP8 = 0 ;
  18164. LIST1 = MOTS CROI TRIA PLUS LOSA CARR TRIB ETOI TRIB CARR LOSA CROI TRIA PLUS LOSA CARR TRIB ETOI TRIB CARR LOSA CROI TRIA PLUS LOSA CARR TRIB ETOI TRIB CARR LOSA;
  18165. *js250796 TAC8 = TABLE ;
  18166. SI ( EXISTE TAB1 LI_POINT ) ;
  18167. REPETER BOUPO8 ( DIME TAB1.LI_POINT ) ;
  18168. IPP8 = IPP8 + 1 ;
  18169. MARQ1 = EXTR IPP8 LIST1;
  18170. N_P1 = EXTR IPP8 TAB1.LI_POINT ;
  18171. TAC8.IPP8 = CHAINE 'MARQ ' MARQ1 ' REGU TITR ' N_P1 ;
  18172. TITRE N_P1 ' TEMP CALCULATION ' ;
  18173. TAB1.EVT1 = EVOL MANU ' ' PTT1 'TEMPERATURE' TAB1. LIS_TEMP . IPP8 ;
  18174. SI ( IPP8 EGA 1 ) ;
  18175. TAB1.EVTTT1 = TAB1.EVT1 ;
  18176. SINON ;
  18177. TAB1.EVTTT1 = TAB1.EVTTT1 ET TAB1.EVT1 ;
  18178. FINSI ;
  18179. FIN BOUPO8 ;
  18180. MESS '>@PTRANS> >>> 5 >>>>>>>' ;
  18181. TITRE '-P' IFIG '- PROFIL T. SURF. EXT.' PHIZERO;
  18182. *
  18183. IFIG = IFIG + 1 ;
  18184. TITRE '-P' IFIG '- EVOL. T. SURF.' PHIZERO ;
  18185. SI ( NON (EXISTE TAB1 OPT_CADPT) ) ;
  18186. TAB1.OPT_CADPT = MOT ' ' ;
  18187. FINSI ;
  18188.  
  18189. * EVTR2 = EVT1 * 0. ;
  18190. * EVTTT1 = ( EVTTT1 ET EVTR2 ) ;
  18191. * DESSIN EVTTT1 LEGE MIMA TAC8 ;
  18192. TTTTT1 = TEXT 'DESSIN TAB1.EVTTT1 ' (TAB1.OPT_CADPT) 'LEGE MIMA TAC8 ' ;
  18193. TTTTT1 ;
  18194. MESS '>@PTRANS> >>> 6 >>>>>>>' ;
  18195. FINSI ;
  18196. si (existe tab1 points) ;
  18197. repe boupo8 ;
  18198. si (existe ind1 &boupo8) ;
  18199. marq1 = extr &boupo8 LIST1;
  18200. n_p1 = ind1.&boupo8 ;
  18201. TAC8.&boupo8 = CHAINE 'MARQ ' MARQ1 ' REGU TITR ' N_P1 ;
  18202. TITRE N_P1 ' TEMP CALCULATION ' ;
  18203. TAB1.EVT1 = EVOL MANU ' ' PTT1 'TEMPERATURE' TAB1. LIS_TEMP . &boupo8 ;
  18204. SI ( &boupo8 EGA 1 ) ;
  18205. TAB1.EVTTT1 = TAB1.EVT1 ;
  18206. SINON ;
  18207. TAB1.EVTTT1 = TAB1.EVTTT1 ET TAB1.EVT1 ;
  18208. FINSI ;
  18209. sinon ;
  18210. quitter boupo8 ;
  18211. finsi ;
  18212. fin boupo8 ;
  18213. MESS '>@PTRANS> >>> 5 >>>>>>>' ;
  18214. TITRE '-P' IFIG '- PROFIL T. SURF. EXT.' PHIZERO;
  18215. IFIG = IFIG + 1 ;
  18216. TITRE '-P' IFIG '- EVOL. T. SURF.' PHIZERO ;
  18217. SI ( NON (EXISTE TAB1 OPT_CADPT) ) ;
  18218. TAB1.OPT_CADPT = MOT ' ' ;
  18219. FINSI ;
  18220. TTTTT1 = TEXT 'DESSIN TAB1.EVTTT1 ' (TAB1.OPT_CADPT) 'LEGE MIMA TAC8 ' ;
  18221. TTTTT1 ;
  18222. MESS '>@PTRANS> >>> 6 >>>>>>>' ;
  18223. finsi ;
  18224. MESS '>>>>> 7 >>>>>>>' ;
  18225. SI (NIVEAU >EG 4) ;
  18226. MESS '---------------------------------> exiting @PTRANS';
  18227. FINSI ;
  18228. FINPROC ;
  18229.  
  18230.  
  18231. DEBPROC RAMRES CONT1*MCHAML MOD1*MMODEL MAIL1*MAILLAGE COMP1*MOT;
  18232.  
  18233. * calcul de la resultant d'un MCHAML
  18234.  
  18235.  
  18236. CONTU1 = REDU (EXTR MOD1 MAIL) CONT1;
  18237. CONTU2 = PROI MAIL1 (CHAN NOEUD MOD1 CONTU1) ;
  18238.  
  18239. * CONTU2 = CHAN CHPO MOD1 (CHAN NOEUD MOD1 CONTU1) ;
  18240. * CONTU3 = REDU CONTU2 MAIL1 ;
  18241. * CONTU4 = CHAN CHAM CONTU2 MAIL1 NOEUD ;
  18242.  
  18243. CONTU3 = CHAN CHAM CONTU2 MAIL1 NOEUD ;
  18244. MODD1 = MODE MAIL1 MECANIQUE ELASTIQUE ISOTROPE ;
  18245. VAL1 = INTG MODD1 CONTU3 COMP1 ;
  18246.  
  18247. * mettre une autre methode passat par REAC et
  18248. * que je trouve plus propre
  18249.  
  18250.  
  18251.  
  18252. FINPROC VAL1;
  18253.  
  18254. **** @RAPACQU
  18255. DEBPROC @RAPACQU NDON1*ENTIER NABSC1*ENTIER TAB1*TABLE;
  18256. MESS '--------------------------------> calling @RAPACQU';
  18257. I1 = 0 ;
  18258. REPETER BOUC1 NDON1 ;
  18259. I1 = I1 + 1 ;
  18260. TAB1.I1 = PROG ;
  18261. FIN BOUC1 ;
  18262.  
  18263. REPETER BOUC2 NABSC1;
  18264. ACQU LR1*LISTREEL NDON1;
  18265. I2 = 0 ;
  18266. REPETER BOUC3 NDON1;
  18267. I2 = I2 + 1 ;
  18268. TAB1.I2 = TAB1.I2 ET (PROG (EXTR LR1 I2));
  18269. FIN BOUC3;
  18270. FIN BOUC2 ;
  18271.  
  18272. MESS '--------------------------------> exiting @RAPACQU';
  18273. FINPROC ;
  18274.  
  18275.  
  18276.  
  18277.  
  18278. 'DEBPROC' RDPGTHPL RIG10*RIGIDITE MAT1*CHAMELEM ASCU0/AFFECTE TE1*CHPOINT TABDEP1*TABLE ;
  18279. *----------------------------------------------------------------------*
  18280. * *
  18281. * R D P G T H P L *
  18282. * --------------- *
  18283. * *
  18284. * RESOLUTION EN DEFORMATION PLANE GENERALISEE D UN *
  18285. * PB THERMOMECANIQUE *
  18286. * *
  18287. * *
  18288. * RIG10 MATRICE DE RIGIDITE *
  18289. * MAT1 CHAMELEM DES MATERIAUX *
  18290. * ( ASCU0 ) OBJET AFFECTE ( ELEMENTS FINIS ) *
  18291. * TE1 CHPOIN DE TEMPERATURE ( CHARGEMENT ) *
  18292. * TABDEP TABLE *
  18293. * INDICE 'NZ' EFFORT LONGITUDINAL IMPOSE *
  18294. * INDICE 'TINI' TEMPERATURE INITIALE *
  18295. * INDICE 'LIG1' LIGNE POUR APPLICATION CHARGEMENT BIDON *
  18296. * INDICE 'MX' MOMENT EN X IMPOSE *
  18297. * INDICE 'MY' ...A PROGRAMMER SUIV. MOD. MX *
  18298. * ( INDICE 'PO') CENTRE D'INERTIE DE VOTRE SURFACE *
  18299. * ( INDICE 'VX') LE VX POUR SFXX = MXX/(IXX/VX) *
  18300. * *
  18301. * EN SORTIE *
  18302. * DE1 CHPOINT DE DEPLACEMENT *
  18303. * SIG1 CONTRAINTES *
  18304. * *
  18305. * CE JEU DE DONNEES A ETE UTILISE TEL QUE ET A SEMBLE DONNER
  18306. * SATISFACTION *
  18307. * IL FAUDRAIT EN FAIRE UNE PROCEDURE *
  18308. * ET LE TESTER CONVENABLEMENT *
  18309. * *
  18310. * SCHLOSSER LE 13 9 90 *
  18311. * *
  18312. * SCHLOSSER LE 17 7 91 *
  18313. * *
  18314. * TABDEP1.'EPSI' CHAMELEM DES DEFORMATIONS
  18315. * TABDEP1.'RY' RAYON DE COURBURE EN Y
  18316. * TABDEP1.'EPZM' DEFORMATION MOYENNE EN Z *
  18317. * ( INDICE 'PO') CENTRE DE L AXE NEUTRE *
  18318. * ( INDICE 'VX') LE VX POUR SFXX = MXX/(IXX/VX) *
  18319. *----------------------------------------------------------------------*
  18320. *23456789012345678901234567890123456789012345678901234567890123456789012
  18321. *--------1---------2---------3---------4---------5---------6---------7-*
  18322. ******* CALCUL DES FORCES DUES AUX TEMPERATURES **************
  18323. *
  18324. MESS ' >>>>> ATTENTION VERIFIEZ QUE VOUS AVEZ PLAN DEFO >>>>>>>>' ;
  18325. LISTE ( VALEUR 'MODE' ) ;
  18326. SI ( EXISTE ASCU0 ) ;
  18327. ASCU1 = ASCU0 ;
  18328. SINON ;
  18329. ASCU1 = EXTR MAT1 'AFFE' ;
  18330. TITRE 'ASCU1';
  18331. TRACE ASCU1 ;
  18332. FINSI ;
  18333. MAIL_1 = EXTR ASCU1 'MAIL' ;
  18334. TITRE 'MAIL_1';
  18335. TRACE MAIL_1 ;
  18336. IGENE = 0 ;
  18337. SI_10 = THETA MAT1 ( TE1 - ( TABDEP1.TINI ) ) ;
  18338. SIONE = MANU CHAM ASCU1 CONTRAIN SMZZ 1. ;
  18339. SIERR = MANU CHAM ASCU1 CONTRAIN SMZZ 0. ;
  18340. SECC = EXTR SI_10 'MAIL' ;
  18341. A_1 = 1.0 ;
  18342. TOL_1 = 1.E-15 ;
  18343. TOL_2 = 1.E-18 ;
  18344. YG1 = CHAN 'STRESSES' ( EXCO 'YOUNG' MAT1 ) ;
  18345. SEC_1 = INTG SIONE SMZZ ;
  18346. MESS ' VOTRE SURFACE SECTION A VERIFIER' SEC_1 ;
  18347. SI ( EXISTE TABDEP1 NZ ) ;
  18348. IGENE = IGENE + 1 ;
  18349. FINSI ;
  18350. SI ( EXISTE TABDEP1 MX ) ;
  18351. IGENE = IGENE + 1 ;
  18352. PO_1 = BARY SECC ;
  18353. * L_Y1 = (( COOR 2 SECC ) - ( COOR 2 PO_1 ) ) ;
  18354. Y_1 = COOR 2 SECC ;
  18355. Y_2 = PRCH Y_1 ASCU1 STRESSES ;
  18356. Y_PO2 = ( INTG ( Y_2 * YG1 ) ) / ( INTG YG1 ) ;
  18357. L_Y1 = ( Y_1 - Y_PO2 ) ;
  18358. X_1 = COOR 1 SECC ;
  18359. X_2 = PRCH X_1 ASCU1 STRESSES ;
  18360. X_PO2 = ( INTG ( X_2 * YG1 ) ) / ( INTG YG1 ) ;
  18361. L_X1 = ( X_1 - X_PO2 ) ;
  18362. PO_2 = ( X_PO2 Y_PO2 ) ;
  18363. TABDEP1.PO = PO_2 ;
  18364. VX_1 = MAXI ( ABS L_Y1 ) ;
  18365. TABDEP1.VX = VX_1 ;
  18366. L_Y = PRCH L_Y1 ASCU1 STRESSES ;
  18367. IXX_1 = INTG ( L_Y * L_Y ) ;
  18368. MESS ' VOTRE BARICENTRE ' ( COOR 1 PO_1 ) ( COOR 2 PO_1 ) ;
  18369. MESS ' VOTRE CENTRE D AXE NEUTRE ' ( COOR 1 PO_2 ) ( COOR 2 PO_2 ) ;
  18370. MESS ' VOTRE VX ' VX_1 ;
  18371. MESS ' VOTRE INERTIE IXX A VERIFIER' IXX_1 ;
  18372. FINSI ;
  18373. IB = 0 ;
  18374. TBB1 = TABLE ;
  18375. TBB1.CHPOTHETA = TABLE ;
  18376. TBB1.PLASTIQUE = VRAI ;
  18377. TBB1.THERMIQUE = VRAI ;
  18378. TBB1.ITERATION = KSI ;
  18379. *TREFERENCE = 0.;
  18380. TBB1.CHPOTHETA . 0. = 0. ;
  18381. TBB1.CHPOTHETA . 1. = (TE1 - (MANU 'CHPO' MAIL_1 1 'T' ( TABDEP1.TINI ))) ;
  18382. VPREC = 0.1 ;
  18383. TBB1.MAXITERATION = 200 ;
  18384. TBB1.ACCELERATION = 20 ;
  18385. LIS1 = PROG 1. 1. ;
  18386. XF1 = PROG 0. 1. ;
  18387. F1 = FORCE FY 0. (TABDEP1.LIG1 ) ;
  18388. CHA1 = CHAR F1 ( EVOL MANU LIS1 XF1 ) ;
  18389. REPETER BODEPG 10 ;
  18390. TBB1 = TABLE ;
  18391. TBB1.CHPOTHETA = TABLE ;
  18392. TBB1.PLASTIQUE = VRAI ;
  18393. TBB1.THERMIQUE = VRAI ;
  18394. TBB1.ITERATION = KSI ;
  18395. *TREFERENCE = 0.;
  18396. TBB1.CHPOTHETA . 0. = 0. ;
  18397. TBB1.CHPOTHETA . 1. = (TE1 - (MANU 'CHPO' MAIL_1 1 'T' ( TABDEP1.TINI ))) ;
  18398. VPREC = 0.1 ;
  18399. TBB1.MAXITERATION = 200 ;
  18400. TBB1.ACCELERATION = 20 ;
  18401. IB = IB + 1 ;
  18402. MESS 'IB = ' IB ;
  18403. SI_11 = SI_10 - SIERR ;
  18404. FO1 = BSIGMA SI_11 ;
  18405. SI ( EXISTE TABDEP1 CHAMP ) ;
  18406. FO1 = FO1 ET ( TABDEP1 . CHAMP ) ;
  18407. FINSI ;
  18408. *MESS ' >>>>>>>fin 1er bsigma ' ;
  18409. *
  18410. ******* CALCUL DE LA SOLUTION **************
  18411. *
  18412. DE1 = RESOU RIG10 FO1 ;
  18413. MESS ' >>>>>>>fin resou ' ;
  18414. * SI_12 = SIGMA DE1 MAT1 ;
  18415. * SI_13 = SI_12 - SI_11 ;
  18416. TBB1.SIGI= SIERR*(+1.) ;
  18417. TBB1.PRECISION = VPREC / IB ;
  18418. NONLIN RIG10 MAT1 CHA1 LIS1 ASCU1 TBB1 ;
  18419. SI_13 = TBB1.RESUCONT . 1. ;
  18420. SI ( IB EGA 1 ) ;
  18421. * MSM1 = MAXI ( ABS SI_13 ) ;
  18422. MSM1 = MAXI ( ABS SI_10 ) ;
  18423. SI ( MSM1 &lt;EG 1.E-20 ) ; MSM1 = 1.E-20 ; FINSI ;
  18424. FINSI ;
  18425. DDD_1 = 0. ;
  18426. DDD_2 = 0. ;
  18427. SI ( EXISTE TABDEP1 NZ ) ;
  18428. FZ_1 = INTG SI_13 SMZZ ;
  18429. DFZ_1 = ( TABDEP1.NZ ) - FZ_1 ;
  18430. DSZ_1 = DFZ_1 / SEC_1 ;
  18431. DRZ_1 = ( ABS DSZ_1 ) / MSM1 ;
  18432. MESS ' ERREUR ABSOLU SIGZZ------' DSZ_1 ;
  18433. MESS ' ERREUR RELATIVE SIGZZ----' DRZ_1 ;
  18434. DDD_1 = DDD_1 + DRZ_1 ;
  18435. DDD_2 = DDD_2 + ( ABS DSZ_1 ) ;
  18436. SIERR = SIERR + ( MANU CHAM ASCU1 CONTRAIN SMZZ ( A_1 * DSZ_1 )) ;
  18437. MESS ' >>>>>>>fin sierr1 ' ;
  18438. FINSI ;
  18439. SI ( EXISTE TABDEP1 MX ) ;
  18440. MX_1 = INTG ( SI_13 * L_Y ) SMZZ ;
  18441. DMX_1 = ( TABDEP1.MX ) - MX_1 ;
  18442. DSX_1 = DMX_1 / IXX_1 * VX_1 ;
  18443. DRX_1 = ( ABS DSX_1 ) / MSM1 ;
  18444. MESS ' ERREUR ABSOLU EN FLEXION SIGFX------' DSX_1 ;
  18445. MESS ' ERREUR RELATIVE EN FLEXION SIGFX----' DRX_1 ;
  18446. DDD_1 = DDD_1 + DRX_1 ;
  18447. DDD_2 = DDD_2 + ( ABS DSX_1 ) ;
  18448. SIERR = SIERR + ( ( SIONE * L_Y ) * ( A_1 * DMX_1 / IXX_1 )) ;
  18449. MESS ' >>>>>>>fin sierr2 ' ;
  18450. FINSI ;
  18451. SI ( IGENE EGA 0 ) ;
  18452. QUITTER BODEPG ;
  18453. MESS ' >>>>>>>AUCUNE CONDITION DE DEFO GENE ' ;
  18454. MESS ' >>>>>>>CALCUL EFFECTUE EN PLAN ' ;
  18455. FINSI ;
  18456. SI ( IB >EG 2 ) ;
  18457. SI ( DDD_1 &lt;EG TOL_1 ) ; QUITTER BODEPG ; FINSI ;
  18458. SI ( DDD_2 &lt;EG TOL_2 ) ; QUITTER BODEPG ; FINSI ;
  18459. FINSI ;
  18460. MESS ' >>>>>>>on reboucle ' ;
  18461. FIN BODEPG ;
  18462. SIG1 = SI_13 ;
  18463. *ALPH1 = CHAN 'STRESSES' ( EXCO 'ALPH' MAT1 ) ;
  18464. *EPT = ALPH1 * ( PRCH TE1 ASCU1 'STRESSES' ) ;
  18465. ALPH1 = CHAN 'CHPO' ( EXCO 'ALPH' MAT1 ) ;
  18466. EPT = PRCH ( TE1 * ALPH1 ) ASCU1 'STRESSES' ;
  18467. *list EPT ;
  18468. ETXX = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPXX' EPT ;
  18469. ETYY = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPYY' EPT ;
  18470. ETZZ = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPZZ' EPT ;
  18471. CHEPS = ( ELAS SI_13 MAT1 ) + ETXX + ETYY + ETZZ ;
  18472. EPSZZ = EXCO EPZZ CHEPS ;
  18473. EPZM = ( INTG EPSZZ ) / SEC_1 ;
  18474. MESS ' VOTRE EPZ MOYEN : ' EPZM ;
  18475. EPBZ = EPSZZ - (( EPSZZ ** 0 ) * EPZM ) ;
  18476. SI ( EXISTE TABDEP1 MX ) ;
  18477. CHRY = L_Y * ( EPBZ ** -1 ) * -1. ;
  18478. MESS ' MAXI MINI DE VOTRE RY QUI DEVRAIT ETRE CONSTANT ' ( MAXI CHRY ) ( MINI CHRY ) ;
  18479. RY = ( INTG CHRY ) / SEC_1 ;
  18480. TABDEP1.'RY' = RY ;
  18481. FINSI ;
  18482. TABDEP1.'EPSI' = CHEPS ;
  18483. TABDEP1.'EPZM' = EPZM ;
  18484. FINPROC DE1 SIG1 ;
  18485. **** @REMOJET
  18486.  
  18487. DEBPROC @REMOJET XG_OLD2*CHPOINT YG_OLD2*CHPOINT ZG_OLD2*CHPOINT PAS0*FLOTTANT CHSIGN2*CHPOINT TAB1*TABLE ;
  18488.  
  18489. *MESS '---------------------------------> calling @remojet';
  18490. *
  18491. IMETHOD = TAB1.<METHODE_REMONTEE ;
  18492. *
  18493. *---- Methode Explicite
  18494. SI (IMETHOD EGA 1) ;
  18495. DEPX0 DEPY0 DEPZ0 = @DEXPJET XG_OLD2 YG_OLD2 ZG_OLD2 PAS0 TAB1;
  18496. SINON ;
  18497. ERRE '>>> METHODE INDISPONIBLE' ;
  18498. FINSI ;
  18499. *
  18500. *---- On affecte le signe donnant le sens de remontee
  18501. *---- aux deplacements
  18502. DEPX0 = CHSIGN2 * DEPX0 ;
  18503. DEPY0 = CHSIGN2 * DEPY0 ;
  18504. DEPZ0 = CHSIGN2 * DEPZ0 ;
  18505. *
  18506. *---- Calcul analytique des nouvelles coordonnees dans le
  18507. *---- repere global
  18508. XG_NEW2 = XG_OLD2 + DEPX0 ;
  18509. YG_NEW2 = YG_OLD2 + DEPY0 ;
  18510. ZG_NEW2 = ZG_OLD2 + DEPZ0 ;
  18511. *
  18512. *---- actualisation de la position des points de la ligne
  18513. DEPX0 = NOMC UX DEPX0 NATURE DIFFUS ;
  18514. DEPY0 = NOMC UY DEPY0 NATURE DIFFUS ;
  18515. DEPZ0 = NOMC UZ DEPZ0 NATURE DIFFUS ;
  18516. DEP0 = DEPX0 ET DEPY0 ET DEPZ0 ;
  18517. *
  18518. *MESS '---------------------------------> exiting @remojet';
  18519. FINPROC XG_NEW2 YG_NEW2 ZG_NEW2 DEP0 ;
  18520.  
  18521. **** @REMONTE
  18522.  
  18523. DEBPROC @REMONTE XG_OLD2*CHPOINT YG_OLD2*CHPOINT ZG_OLD2*CHPOINT PAS0*FLOTTANT CHSIGN2*CHPOINT TAB1*TABLE ;
  18524.  
  18525. *MESS '---------------------------------> calling @remonte';
  18526. *
  18527.  
  18528. IMETHOD = TAB1.<METHODE_REMONTEE ;
  18529.  
  18530. *---- Appel de la procedure de calcul des deplacements selon methode choisie
  18531. *---- Methode Explicite
  18532. SI (IMETHOD EGA 1) ;
  18533. DEPX0 DEPY0 DEPZ0 = @DEXPLI XG_OLD2 YG_OLD2 ZG_OLD2 PAS0 TAB1;
  18534. FINSI ;
  18535. *---- Methode Euler-Cauchy
  18536. SI (IMETHOD EGA 2) ;
  18537. DEPX0 DEPY0 DEPZ0 = @DMOYEN XG_OLD2 YG_OLD2 ZG_OLD2 PAS0 CHSIGN2 TAB1;
  18538. FINSI ;
  18539. *---- Methode Point Milieu Modifiee
  18540. SI (IMETHOD EGA 3) ;
  18541. DEPX0 DEPY0 DEPZ0 =@DMILIEU XG_OLD2 YG_OLD2 ZG_OLD2 PAS0 CHSIGN2 TAB1;
  18542. FINSI ;
  18543. *---- Methode de Reprojection
  18544. SI (IMETHOD EGA 4) ;
  18545. DEPX0 DEPY0 DEPZ0 =@DREPROJ XG_OLD2 YG_OLD2 ZG_OLD2 PAS0 CHSIGN2 TAB1;
  18546. FINSI ;
  18547.  
  18548. *---- On affecte le signe donnant le sens de remontee aux deplacements
  18549. DEPX0 = CHSIGN2 * DEPX0 ;
  18550. DEPY0 = CHSIGN2 * DEPY0 ;
  18551. DEPZ0 = CHSIGN2 * DEPZ0 ;
  18552.  
  18553. *---- Calcul analytique des nouvelles coordonnees dans le repere global
  18554.  
  18555. XG_NEW2 = XG_OLD2 + DEPX0 ;
  18556. YG_NEW2 = YG_OLD2 + DEPY0 ;
  18557. ZG_NEW2 = ZG_OLD2 + DEPZ0 ;
  18558.  
  18559. *MESS '---------------------------------> exiting @remonte';
  18560. FINPROC XG_NEW2 YG_NEW2 ZG_NEW2 ;
  18561.  
  18562. **** @repere
  18563. debproc @repere flot1*entier ;
  18564. o1 = 0. 0. 0. ;
  18565. 32taa1 = table ;
  18566. 32tab1 = table ;
  18567. 32tac1 = table ;
  18568.  
  18569. repe bouc1 10 ;
  18570. 32taa1.&bouc1 = &bouc1 0. 0. ;
  18571. 32tab1.&bouc1 = 0. &bouc1 0. ;
  18572. 32tac1.&bouc1 = 0. 0. &bouc1 ;
  18573. si (ega &bouc1 1 ) ;
  18574. geo1 = ((o1 d 1 32taa1.&bouc1) coul jaun) et ((o1 d 1 32tab1.&bouc1) coul bleu) et ((o1 d 1 32tac1.&bouc1) coul vert) ;
  18575. sinon ;
  18576. geo1 = geo1 et ((32taa1.(&bouc1 - 1) d 1 32taa1.&bouc1) coul jaun) et ((32tab1.(&bouc1 - 1) d 1 32tab1.&bouc1) coul bleu) et ((32tac1.(&bouc1 - 1) d 1 32tac1.&bouc1) coul vert);
  18577.  
  18578. finsi ;
  18579. fin bouc1;
  18580. geo2 = geo1 homo flot1 o1 ;
  18581.  
  18582.  
  18583. finproc geo1 ;
  18584.  
  18585.  
  18586. **** RESDPG
  18587. *-------------------------------------------------
  18588.  
  18589. 'DEBPROC' RESDPG RIG10*RIGIDITE MAT1*CHAMELEM ASCU0/AFFECTE TE1*CHPOINT TABDEP1*TABLE ;
  18590. *----------------------------------------------------------------------*
  18591. * *
  18592. * R E S D P G *
  18593. * --------------- *
  18594. * *
  18595. * RESOLUTION EN DEFORMATION PLANE GENERALISEE D UN *
  18596. * PB THERMOMECANIQUE *
  18597. * *
  18598. * *
  18599. * RIG10 MATRICE DE RIGIDITE *
  18600. * MAT1 CHAMELEM DES MATERIAUX *
  18601. * ( ASCU0 ) OBJET AFFECTE ( ELEMENTS FINIS ) *
  18602. * TE1 CHPOIN DE TEMPERATURE ( CHARGEMENT ) *
  18603. * TABDEP TABLE *
  18604. * INDICE 'NZ' EFFORT LONGITUDINAL IMPOSE *
  18605. * INDICE 'MX' MOMENT EN X IMPOSE *
  18606. * INDICE 'MY' ...A PROGRAMMER SUIV. MOD. MX *
  18607. * ( INDICE 'PO') CENTRE D'INERTIE DE VOTRE SURFACE *
  18608. * ( INDICE 'VX') LE VX POUR SFXX = MXX/(IXX/VX) *
  18609. * *
  18610. * EN SORTIE *
  18611. * DE1 CHPOINT DE DEPLACEMENT *
  18612. * SIG1 CONTRAINTES *
  18613. * *
  18614. * CE JEU DE DONNEES A ETE UTILISE TEL QUE ET A SEMBLE DONNER
  18615. * SATISFACTION *
  18616. * IL FAUDRAIT EN FAIRE UNE PROCEDURE *
  18617. * ET LE TESTER CONVENABLEMENT *
  18618. * *
  18619. * SCHLOSSER LE 13 9 90 *
  18620. * *
  18621. * SCHLOSSER LE 17 7 91 *
  18622. * *
  18623. * TABDEP1.'EPSI' CHAMELEM DES DEFORMATIONS
  18624. * TABDEP1.'RY' RAYON DE COURBURE EN Y
  18625. * TABDEP1.'EPZM' DEFORMATION MOYENNE EN Z *
  18626. * ( INDICE 'PO') CENTRE DE L AXE NEUTRE *
  18627. * ( INDICE 'VX') LE VX POUR SFXX = MXX/(IXX/VX) *
  18628. *----------------------------------------------------------------------*
  18629. *
  18630. ******* CALCUL DES FORCES DUES AUX TEMPERATURES **************
  18631. *
  18632. MESS ' >>>>> ATTENTION VERIFIEZ QUE VOUS AVEZ PLAN DEFO >>>>>>>>' ;
  18633. LISTE ( VALEUR 'MODE' ) ;
  18634. SI ( EXISTE ASCU0 ) ;
  18635. ASCU1 = ASCU0 ;
  18636. SINON ;
  18637. ASCU1 = EXTR MAT1 'AFFE' ;
  18638. FINSI ;
  18639. IGENE = 0 ;
  18640. SI_10 = THETA MAT1 TE1 ;
  18641. SIONE = MANU CHAM ASCU1 CONTRAIN SMZZ 1. ;
  18642. SIERR = MANU CHAM ASCU1 CONTRAIN SMZZ 0. ;
  18643. SECC = EXTR SI_10 'MAIL' ;
  18644. A_1 = 1.0 ;
  18645. TOL_1 = 1.E-15 ;
  18646. TOL_2 = 1.E-18 ;
  18647. YG1 = CHAN 'STRESSES' ( EXCO 'YOUNG' MAT1 ) ;
  18648. SEC_1 = INTG SIONE SMZZ ;
  18649. MESS ' VOTRE SURFACE SECTION A VERIFIER' SEC_1 ;
  18650. SI ( EXISTE TABDEP1 NZ ) ;
  18651. IGENE = IGENE + 1 ;
  18652. FINSI ;
  18653. SI ( EXISTE TABDEP1 MX ) ;
  18654. IGENE = IGENE + 1 ;
  18655. PO_1 = BARY SECC ;
  18656. * L_Y1 = (( COOR 2 SECC ) - ( COOR 2 PO_1 ) ) ;
  18657. Y_1 = COOR 2 SECC ;
  18658. Y_2 = PRCH Y_1 ASCU1 STRESSES ;
  18659. Y_PO2 = ( INTG ( Y_2 * YG1 ) ) / ( INTG YG1 ) ;
  18660. L_Y1 = ( Y_1 - Y_PO2 ) ;
  18661. X_1 = COOR 1 SECC ;
  18662. X_2 = PRCH X_1 ASCU1 STRESSES ;
  18663. X_PO2 = ( INTG ( X_2 * YG1 ) ) / ( INTG YG1 ) ;
  18664. L_X1 = ( X_1 - X_PO2 ) ;
  18665. PO_2 = ( X_PO2 Y_PO2 ) ;
  18666. TABDEP1.PO = PO_2 ;
  18667. VX_1 = MAXI ( ABS L_Y1 ) ;
  18668. TABDEP1.VX = VX_1 ;
  18669. L_Y = PRCH L_Y1 ASCU1 STRESSES ;
  18670. IXX_1 = INTG ( L_Y * L_Y ) ;
  18671. MESS ' VOTRE BARICENTRE ' ( COOR 1 PO_1 ) ( COOR 2 PO_1 ) ;
  18672. MESS ' VOTRE CENTRE D AXE NEUTRE ' ( COOR 1 PO_2 ) ( COOR 2 PO_2 ) ;
  18673. MESS ' VOTRE VX ' VX_1 ;
  18674. MESS ' VOTRE INERTIE IXX A VERIFIER' IXX_1 ;
  18675. FINSI ;
  18676. IB = 0 ;
  18677. REPETER BODEPG 10 ;
  18678. IB = IB + 1 ;
  18679. MESS 'IB = ' IB ;
  18680. SI_11 = SI_10 - SIERR ;
  18681. FO1 = BSIGMA SI_11 ;
  18682. SI ( EXISTE TABDEP1 CHAMP ) ;
  18683. FO1 = FO1 ET ( TABDEP1 . CHAMP ) ;
  18684. FINSI ;
  18685. *MESS ' >>>>>>>fin 1er bsigma ' ;
  18686. *
  18687. ******* CALCUL DE LA SOLUTION **************
  18688. *
  18689. DE1 = RESOU RIG10 FO1 ;
  18690. MESS ' >>>>>>>fin resou ' ;
  18691. SI_12 = SIGMA DE1 MAT1 ;
  18692. SI_13 = SI_12 - SI_11 ;
  18693. SI ( IB EGA 1 ) ;
  18694. * MSM1 = MAXI ( ABS SI_13 ) ;
  18695. MSM1 = MAXI ( ABS SI_10 ) ;
  18696. SI ( MSM1 &lt;EG 1.E-20 ) ; MSM1 = 1.E-20 ; FINSI ;
  18697. FINSI ;
  18698. DDD_1 = 0. ;
  18699. DDD_2 = 0. ;
  18700. SI ( EXISTE TABDEP1 NZ ) ;
  18701. FZ_1 = INTG SI_13 SMZZ ;
  18702. DFZ_1 = ( TABDEP1.NZ ) - FZ_1 ;
  18703. DSZ_1 = DFZ_1 / SEC_1 ;
  18704. DRZ_1 = ( ABS DSZ_1 ) / MSM1 ;
  18705. MESS ' ERREUR ABSOLU SIGZZ------' DSZ_1 ;
  18706. MESS ' ERREUR RELATIVE SIGZZ----' DRZ_1 ;
  18707. DDD_1 = DDD_1 + DRZ_1 ;
  18708. DDD_2 = DDD_2 + ( ABS DSZ_1 ) ;
  18709. SIERR = SIERR + ( MANU CHAM ASCU1 CONTRAIN SMZZ ( A_1 * DFZ_1 / SEC_1 )) ;
  18710. MESS ' >>>>>>>fin sierr1 ' ;
  18711. FINSI ;
  18712. SI ( EXISTE TABDEP1 MX ) ;
  18713. MX_1 = INTG ( SI_13 * L_Y ) SMZZ ;
  18714. DMX_1 = ( TABDEP1.MX ) - MX_1 ;
  18715. DSX_1 = DMX_1 / IXX_1 * VX_1 ;
  18716. DRX_1 = ( ABS DSX_1 ) / MSM1 ;
  18717. MESS ' ERREUR ABSOLU EN FLEXION SIGFX------' DSX_1 ;
  18718. MESS ' ERREUR RELATIVE EN FLEXION SIGFX----' DRX_1 ;
  18719. DDD_1 = DDD_1 + DRX_1 ;
  18720. DDD_2 = DDD_2 + ( ABS DSX_1 ) ;
  18721. SIERR = SIERR + ( ( SIONE * L_Y ) * ( A_1 * DMX_1 / IXX_1 )) ;
  18722. MESS ' >>>>>>>fin sierr2 ' ;
  18723. FINSI ;
  18724. SI ( IGENE EGA 0 ) ;
  18725. QUITTER BODEPG ;
  18726. MESS ' >>>>>>>AUCUNE CONDITION DE DEFO GENE ' ;
  18727. MESS ' >>>>>>>CALCUL EFFECTUE EN PLAN ' ;
  18728. FINSI ;
  18729. SI ( IB >EG 2 ) ;
  18730. SI ( DDD_1 &lt;EG TOL_1 ) ; QUITTER BODEPG ; FINSI ;
  18731. SI ( DDD_2 &lt;EG TOL_2 ) ; QUITTER BODEPG ; FINSI ;
  18732. FINSI ;
  18733. MESS ' >>>>>>>on reboucle ' ;
  18734. FIN BODEPG ;
  18735. SIG1 = SI_13 ;
  18736. *ALPH1 = CHAN 'STRESSES' ( EXCO 'ALPH' MAT1 ) ;
  18737. *EPT = ALPH1 * ( PRCH TE1 ASCU1 'STRESSES' ) ;
  18738. ALPH1 = CHAN 'CHPO' ( EXCO 'ALPH' MAT1 ) ;
  18739. EPT = PRCH ( TE1 * ALPH1 ) ASCU1 'STRESSES' ;
  18740. *list EPT ;
  18741. ETXX = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPXX' EPT ;
  18742. ETYY = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPYY' EPT ;
  18743. ETZZ = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPZZ' EPT ;
  18744. CHEPS = ( ELAS SI_13 MAT1 ) + ETXX + ETYY + ETZZ ;
  18745. EPSZZ = EXCO EPZZ CHEPS ;
  18746. EPZM = ( INTG EPSZZ ) / SEC_1 ;
  18747. MESS ' VOTRE EPZ MOYEN : ' EPZM ;
  18748. EPBZ = EPSZZ - (( EPSZZ ** 0 ) * EPZM ) ;
  18749. SI ( EXISTE TABDEP1 MX ) ;
  18750. CHRY = L_Y * ( EPBZ ** -1 ) * -1. ;
  18751. MESS ' MAXI MINI DE VOTRE RY QUI DEVRAIT ETRE CONSTANT ' ( MAXI CHRY ) ( MINI CHRY ) ;
  18752. RY = ( INTG CHRY ) / SEC_1 ;
  18753. TABDEP1.'RY' = RY ;
  18754. FINSI ;
  18755. TABDEP1.'EPSI' = CHEPS ;
  18756. TABDEP1.'EPZM' = EPZM ;
  18757. FINPROC DE1 SIG1 ;
  18758. **** @resflux
  18759. debproc @resflux cht1*chpoint geo1*maillage geo2*maillage lambda1/flottant cara1/mchaml mod1*mmodel ;
  18760. mess '---------------------------------> calling @RESFLUX';
  18761. v1 = vale dime ;
  18762. *
  18763. * --- calcul du flux
  18764. *
  18765. si (exis lambda1) ;
  18766. lambda2 = lambda1 ;
  18767. sinon ;
  18768. si (exis cara1) ;
  18769. lambda2 = vari nuag mod1 (redu cara1 mod1) cht1 ;
  18770. lambda3 = chan chpo lambda2 mod1 ;
  18771. lambda4 = chan attribut lambda3 nature discret ;
  18772. lambda5 = exco lambda4 'K' ;
  18773. lambda1 = lambda5 ;
  18774. sinon ;
  18775. erre '>@resflux> NO CONDUCTIVITY' ;
  18776. finsi ;
  18777. finsi ;
  18778.  
  18779. gradt1 = grad cht1 mod1 ;
  18780. gradt2 = chan chpo gradt1 mod1 ;
  18781. gradt3 = chan attribut gradt2 nature discret ;
  18782. gradt4 = gradt3 * lambda1 ;
  18783. *
  18784. * --- calcul des normales
  18785. *
  18786. cosdir1 cosdir2 cosdir3 = @vnorm3d geo2 geo1 ;
  18787. cosdir1 = chan attribut cosdir1 nature discret ;
  18788. cosdir2 = chan attribut cosdir2 nature discret ;
  18789. cosdir3 = chan attribut cosdir3 nature discret ;
  18790. *
  18791. * --- produit scalaire
  18792. *
  18793. si (ega v1 2) ;
  18794. mess '>@resflux> 2D value in (W/m)' ;
  18795. flux1 = ((cosdir1 * (exco gradt4 'T,X')) + (cosdir2 * (exco gradt4 'T,Y')) );
  18796. sinon ;
  18797. mess '>@resflux> 3D value in (W)' ;
  18798. flux1 = ((cosdir1 * (exco gradt4 'T,X')) + (cosdir2 * (exco gradt4 'T,Y')) + (cosdir3 * (exco gradt4 'T,Z')) );
  18799. finsi ;
  18800. *
  18801. * --- int\E9gration
  18802. *
  18803. flux2 = chan cham geo1 flux1 noeud ;
  18804. puis1 = intg (MODL geo1 thermique isotrope) flux2;
  18805. puis1 = abs puis1;
  18806. *
  18807. * --- affichage et fin
  18808. *
  18809. mess '>@resflux> Power through ligne or surface :' puis1 ;
  18810. mess '---------------------------------> exiting @RESFLUX';
  18811. finproc puis1 ;
  18812. **** RESI
  18813. *************************************************************
  18814. * PROCEDURE RESI : CALCUL D'UNE RESISTANCE
  18815. *************************************************************
  18816. DEBPROC RESI TAB1*TABLE ;
  18817. *************************************************************
  18818. * MODELE
  18819. *************************************************************
  18820. MOD1 = TABLE ;
  18821. MAT1 = TABLE ;
  18822. COND1 = TABLE ;
  18823. TMAIL = TAB1.MAILLAGE ;
  18824. TCOND = TAB1.CONDUCT ;
  18825. TELEC = TAB1.ELECTRO ;
  18826. I = 0 ;
  18827. REPETER BOUC1 100 ;
  18828. I = I + 1 ;
  18829. SI (EXIS TMAIL I) ;
  18830. MOD1.I = MODE TMAIL.I THERMIQUE ISOTROPE ;
  18831. MAT1.I = MATE MOD1.I 'K' TCOND.I ;
  18832. COND1.I = COND MOD1.I MAT1.I ;
  18833. SINON ;
  18834. QUITTER BOUC1 ;
  18835. FINSI ;
  18836. FIN BOUC1 ;
  18837. N1 = I - 1 ;
  18838. MESS 'NOMBRE DE MATERIAUX DIFFERENTS :' N1 ;
  18839. *MESS 'CONDUCTIVITES :' ;
  18840. *LIST COND1 ;
  18841. ****************************************************************
  18842. * CONDITIONS AUX LIMITES
  18843. *****************************************************************
  18844. T1 = 1. ;
  18845. T2 = 0. ;
  18846. EL1 = TELEC.1 ;
  18847. EL2 = TELEC.2 ;
  18848. CL1 = BLOQUE T EL1 ;
  18849. CL2 = BLOQUE T EL2 ;
  18850. TI1 = DEPI CL1 T1 ;
  18851. TI2 = DEPI CL2 T2 ;
  18852. ***************************************************************
  18853. * CHARGEMENT
  18854. ***************************************************************
  18855. COUR = TI1 ET TI2 ;
  18856. *****************************************************************
  18857. * RESOLUTION
  18858. *****************************************************************
  18859. AMP1 = 5.E-3 ;
  18860. I = 0 ;
  18861. REPETER BOUC2 N1 ;
  18862. I = I + 1 ;
  18863. SI (EGA I 1);
  18864. CONDT = COND1.1 ;
  18865. MOD1T = MOD1.I ;
  18866. TCONDT = MANU CHPO TMAIL.I 1 SCAL TCOND.I ;
  18867. UNIT = MANU CHPO TMAIL.I 1 SCAL 1. ;
  18868.  
  18869. SINON ;
  18870. CONDT = CONDT ET COND1.I ;
  18871. MOD1T = MOD1T ET MOD1.I ;
  18872. TCONDT =TCONDT ET ( MANU CHPO TMAIL.I 1 SCAL TCOND.I );
  18873. UNIT =UNIT ET ( MANU CHPO TMAIL.I 1 SCAL 1. ) ;
  18874. FINSI ;
  18875. TCONDT = TCONDT / UNIT ;
  18876. FIN BOUC2 ;
  18877. GEO = EXTR CONDT MAIL ;
  18878. RIG1 = CONDT ET CL1 ET CL2 ;
  18879. TEMP1 = RESOU RIG1 COUR ;
  18880. IDIM = VALEUR DIME ;
  18881. SI (EGA IDIM 2) ;
  18882. * TRAC TEMP1 GEO (CONT GEO) ;
  18883. SINON ;
  18884. OEIL1 = 1.E4 1.E4 1.E4 ;
  18885. * TRAC OEIL1 TEMP1 GEO (ENVE GEO) ;
  18886. FINSI ;
  18887. TAB1.GRADIENT = TABLE ;
  18888. GRAD1 = TAB1.GRADIENT ;
  18889. I = 0 ;
  18890. REPETER BOUC3 N1 ;
  18891. I = I + 1 ;
  18892. TEMPI = REDU TEMP1 TMAIL.I ;
  18893. GRAD1.I = (CHAN CHPO MOD1.I ( GRAD MOD1.I TEMPI )) * (-1. * TCOND.I) ;
  18894. SI (EGA I 1);
  18895. MOD1T = MOD1.I ;
  18896. TMAILT = TMAIL.I ;
  18897. GRADT = GRAD1.1 ;
  18898. SINON ;
  18899. MOD1T = MOD1T ET MOD1.I ;
  18900. TMAILT = TMAILT ET TMAIL.I ;
  18901. GRADT = GRADT ET GRAD1.I ;
  18902. FINSI ;
  18903. FIN BOUC3 ;
  18904. *GRADT = (CHAN CHPO MOD1T ( GRAD MOD1T TEMP1 )) *
  18905. *(-1. * TCOND.I) ;
  18906. GRADT = GRADT / UNIT ;
  18907. ***************************************************
  18908. *******
  18909. * CALCUL DU FLUX
  18910. *****************************************************************
  18911. I = 0 ;
  18912. TCH = EXTR GRADT COMP ;
  18913. TCH1 = EXTR TCH 1 ;
  18914. TCH2 = EXTR TCH 2 ;
  18915. **CHX = EXCO TCH1 GRADT JX ;
  18916. **CHY = EXCO TCH2 GRADT JY ;
  18917. SI (EGA IDIM 3) ;
  18918. J1 = ( EXCO TCH1 GRADT JX ) ET ( EXCO TCH2 GRADT JY ) ET ( EXCO TCH3 GRADT JZ ) ;
  18919. SINON ;
  18920. SI (EGA (VALEUR MODE) AXIS) ;
  18921. MESS ' CALCUL EN AXISYMETRIQUE' ;
  18922. MESS ' LA DENSITE DE COURANT EST DONNEE PAR RADIAN' ;
  18923. CHR = COOR 1 GEO ;
  18924. * CCHR = EXTR CHR COMP ;
  18925. * LCHR = MOTS CCHR.1 ;
  18926. * LCHX = MOTS JX ;
  18927. * LCHY = MOTS JY ;
  18928. * CHX = PSCA CHX CHR LCHX LCHR ;
  18929. * CHY = PSCA CHY CHR LCHY LCHR ;
  18930. * CHX = NOMC JX CHX ;
  18931. * CHY = NOMC JY CHY ;
  18932. * J1 = CHX ET CHY ;
  18933. * J1 = ( ( EXCO TCH1 GRADT JX ) * CHR )
  18934. * ET ( ( EXCO TCH2 GRADT JY ) * CHR ) ;
  18935. J1 = ( EXCO TCH1 GRADT JX ) ET ( EXCO TCH2 GRADT JY ) ;
  18936. SINON ;
  18937. J1 = ( EXCO TCH1 GRADT JX ) ET ( EXCO TCH2 GRADT JY ) ;
  18938. FINSI ;
  18939. FINSI ;
  18940. * SI (EGA IDIM 3) ;
  18941. * CHZ = EXCO TCH3 GRADT JZ ;
  18942. * J1 = J1 ET CHZ ;
  18943. * FINSI ;
  18944. REPETER BOUC9 N1 ;
  18945. I = I + 1 ;
  18946. SI (EGA IDIM 3) ;
  18947. GRAD1.I = ( EXCO TCH1 GRAD1.I JX ) ET ( EXCO TCH2 GRAD1.I JY ) ET ( EXCO TCH3 GRAD1.I JZ ) ;
  18948. SINON ;
  18949. SI (EGA (VALEUR MODE) AXIS) ;
  18950. GRAD1.I = ( ( EXCO TCH1 GRAD1.I JX ) * CHR ) ET ( ( EXCO TCH2 GRAD1.I JY ) * CHR ) ;
  18951. SINON ;
  18952. GRAD1.I = ( EXCO TCH1 GRAD1.I JX ) ET ( EXCO TCH2 GRAD1.I JY ) ;
  18953. FINSI ;
  18954. FINSI ;
  18955. FIN BOUC9 ;
  18956. GRAD2 = CHAM EL2 (REDU GRADT EL2) ;
  18957. GEO3 = GEO ELEM APPUYE LARGEMENT EL2 ;
  18958. MODE3 = MODE GEO3 MECANIQUE ELASTIQUE COQ2 TRI3 TRI6 QUA4 QUA8 ;
  18959. SI (EGA IDIM 2) ;
  18960. MODE3 = MODE GEO3 MECANIQUE ELASTIQUE COQ2 TRI3 TRI6 QUA4 QUA8 ;
  18961. SINON ;
  18962. MODE3 = MODE GEO3 MECANIQUE ELASTIQUE CUB8 CU20 TET4 TE10 PRI6 PR15 PYR5 PY13 ;
  18963. FINSI ;
  18964. CHP1 = PRES MASS MODE3 -1. EL2 ;
  18965. TC1 = EXTR CHP1 COMP ;
  18966. TC11 = EXTR TC1 1 ;
  18967. TC12 = EXTR TC1 2 ;
  18968. X1 = EXCO TC11 CHP1 SCAL ;
  18969. Y1 = EXCO TC12 CHP1 SCAL ;
  18970. ALPHA = ATG Y1 X1 ;
  18971. SI (EGA IDIM 2) ;
  18972. CHXN = NOMC 'NX' (COS ALPHA) ;
  18973. CHYN = NOMC 'NY' (SIN ALPHA) ;
  18974. CHN = CHXN + CHYN ;
  18975. SINON ;
  18976. TC13 = EXTR TC1 3 ;
  18977. Z1 = EXCO TC13 CHP1 SCAL ;
  18978. R1 = Y1/(SIN ALPHA) ;
  18979. PHI ATG Z1 R1 ;
  18980. CHXN = NOMC 'NX' ((COS PHI) * (COS ALPHA)) ;
  18981. CHYN = NOMC 'NY' ((COS PHI) * (SIN ALPHA)) ;
  18982. CHZN = NOMC 'NZ' (SIN PHI) ;
  18983. CHN = CHXN + CHYN + CHZN ;
  18984. FINSI ;
  18985. CJ1 = EXTR J1 COMP ;
  18986. CJ11 = EXTR CJ1 1 ;
  18987. CJ12 = EXTR CJ1 2 ;
  18988. CCH1 = EXTR CHN COMP ;
  18989. CCH11 = EXTR CCH1 1 ;
  18990. CCH12 = EXTR CCH1 2 ;
  18991. SI (EGA IDIM 2) ;
  18992. LJ1 = MOTS CJ11 CJ12;
  18993. LCHN = MOTS CCH11 CCH12;
  18994. SINON;
  18995. CJ13 = EXTR CJ1 3 ;
  18996. CCH13 = EXTR CCH1 3 ;
  18997. LJ1 = MOTS CJ11 CJ12 CJ13 ;
  18998. LCHN = MOTS CCH11 CCH12 CCH13;
  18999. FINSI ;
  19000. *LIST LJ1 ;
  19001. *LIST LCHN ;
  19002. CHFLUX = PSCA J1 CHN LJ1 LCHN ;
  19003. CHAMFLUX = CHAN CHAM CHFLUX EL2;
  19004. MO1 = MODE EL2 THERMIQUE ISOTROPE ;
  19005. FLUX1 = INTG MO1 CHAMFLUX ;
  19006. *****************************************************************
  19007. * CALCUL DE LA RESISTANCE
  19008. *****************************************************************
  19009. SI (EGA (VALEUR MODE) AXIS) ;
  19010. PI = 3.14159 ;
  19011. FLUX1 = FLUX1 * (2. * PI) ;
  19012. FINSI ;
  19013. RES1 = (T1 - T2) / FLUX1;
  19014. FINPROC TEMP1 J1 RES1 ;
  19015. *
  19016. DEBPROC @RIPPL TAB1*TABLE ;
  19017. *
  19018. ***********************************************************
  19019. * Version amelioree de la procedure RIPPLE *
  19020. * Alain MOAL (mai 1995) *
  19021. ***********************************************************
  19022. *
  19023. OPTI ECHO 1 ;
  19024. SAUT 2 LIGNE ;
  19025. MESS ' ********** DEBUT DE LA PROCEDURE @RIPPL ***********' ;
  19026. *
  19027. *--------------- VARIABLES D'ENTREE :
  19028. RHO0 = TAB1.<RPLASMA ;
  19029. RPLASMA = TAB1.<RPLASMA ;
  19030. THETA2 = TAB1.<THETA2 ;
  19031. THETA1 = TAB1.<THETA1 ;
  19032. COEF_A1 = TAB1.<COEF_A1 ;
  19033. COEF_B1 = TAB1.<COEF_B1 ;
  19034. COEF_C1 = TAB1.<COEF_C1 ;
  19035. RZERO = TAB1.<R0 ;
  19036. RREF = TAB1.<RREF ;
  19037. CONT1 = TAB1.<CONT ;
  19038. LSIN2T = TAB1.<CONTFIN ;
  19039. CONTFIN1 = TAB1.<CONTFIN ;
  19040. PRHO = TAB1.<PRHO ;
  19041. POINTTOP = TAB1.<PTOP ;
  19042. *------------------------------------
  19043. *---- nombre de bobines
  19044. NBOB = 18. ;
  19045. *
  19046. *---- l'utilite de ce masque ne m'apparait pas clairement
  19047. MASC1 = PRHO MASQUE EGSUPE (RPLASMA - 1.E-3) ;
  19048. PRHO1 = PROG ;
  19049. PDRHO1 = PROG ;
  19050. PRHO2 = PROG ;
  19051. PDRHO2 = PROG ;
  19052. *
  19053. *---- coordonnees polaires dans Rref de l'enveloppe des lignes
  19054. *---- de champ dans le plan Phi = 0
  19055. PRHO2 = ((RPLASMA * MASC1 * (SIN(THETA1)) / (SIN(THETA2))) + ((PRHO - (RPLASMA * MASC1)) / (COS(THETA1 - THETA2)))) ;
  19056. *
  19057. *---- demi-excursion radiale dans Rref
  19058. PDRHO2 = COEF_A1 * (EXP(COEF_B1 *PRHO2)) * (EXP(-1. * COEF_C1 * ((THETA2)**2))) ;
  19059. *
  19060. *---- coordonnees polaires dans Rzero de l'enveloppe des lignes
  19061. *---- de champ dans le plan Phi = 0
  19062. PRHO1 = (((((RREF - RZERO)**2) * MASC1) + (2 * (COS(THETA2)) * (RREF - RZERO) * PRHO2) + ((PRHO2)**2))**0.5) ;
  19063. *
  19064. *---- demi-excursion radiale dans Rzero
  19065. PDRHO1 = (PRHO2 + (MASC1 * (COS(THETA2)) * (RREF - RZERO))) / PRHO1 * PDRHO2 ;
  19066. *---- demi-excursion radiale dans Rzero
  19067. *TEST*PDRHO1 = (PRHO2 + (MASC1 * (COS(THETA2)) * (RREF - RZERO))) /
  19068. *TEST* PRHO * PDRHO2 ;
  19069. *
  19070. *LIST PRHO1 ;
  19071. *LIST PDRHO1 ;
  19072. *
  19073. *---- coordonnees des noeuds du contour
  19074. XCONT1 = COOR 1 CONT1 ;
  19075. YCONT1 = COOR 2 CONT1 ;
  19076. XCONTF1 = COOR 1 CONTFIN1 ;
  19077. YCONTF1 = COOR 2 CONTFIN1 ;
  19078. *
  19079. *---- on doit utiliser un contour constitue de segments a
  19080. *---- 2 noeuds pour le calcul des abcisses curvilignes
  19081. CONT2 = CHAN SEG2 CONT1 ;
  19082. CONTFIN2 = CHAN SEG2 CONTFIN1 ;
  19083. *
  19084. *---- abscisse curviligne pour chaque noeud du contour
  19085. XCUR = EXTR (EVOL CHPO XCONT1 SCAL (INVE CONT1)) ABSC ;
  19086. XCURF = EXTR (EVOL CHPO XCONTF1 SCAL (INVE CONTFIN1)) ABSC ;
  19087. *
  19088. *---- creation du champ a partir de la liste de reels
  19089. CHXCUR = MANU CHPO (INVE CONT2) 1 SCAL XCUR ;
  19090. CHXCURF = MANU CHPO (INVE CONTFIN2) 1 SCAL XCURF ;
  19091. *
  19092. *---- recherche du point extreme en X du contour on suppose
  19093. *---- qu'il est unique et que tous les X sont positifs
  19094. XEXT = MAXI (XCONT1) ;
  19095. PEXT = (XCONT1 POIN MAXI) POIN INITIAL ;
  19096. YEXT = COOR 2 PEXT ;
  19097. *
  19098. LAM0 = RPLASMA - RHO0 ;
  19099. PLAM = PROG LAM0 ;
  19100. PYPL1 = PROG 0. ;
  19101. PXVE = PROG 1.E-3 ;
  19102. PYVE = PROG 0. ;
  19103. I1 = 0 ;
  19104. *
  19105. *---- Pour chaque enveloppe de ligne de champ
  19106. REPETER BOUCL (DIME PRHO1) ;
  19107. I1 = I1 + 1 ;
  19108. *TEST* RHO1 = EXTR I1 PRHO ;
  19109. RHO1 = EXTR I1 PRHO1 ;
  19110. DRHO1 = EXTR I1 PDRHO1 ;
  19111. * MESS 'DRHO1 ' DRHO1 ;
  19112. DENS 3.E-3 ;
  19113. * --- Creation de la ligne de champ
  19114. S1 = 0. (RPLASMA - RHO1) ;
  19115. S2 = (XEXT + (XEXT/10.)) (RPLASMA - RHO1) ;
  19116. LSIN1 = S1 D S2 ;
  19117. XLS1 = COOR 1 LSIN1 ;
  19118. * --- ancien calcul : valable si THETA1 est proche de 90 degres
  19119. * DY1 = -1. * DRHO1 *
  19120. * (COS(XLS1 * (NBOB / RZERO / 3.14159 * 180.)) - 1.) ;
  19121. * --- calcul dans le cas general
  19122. * --- determination iterative de Phi et DY1
  19123. * DY1_OLD = -1. * DRHO1 ;
  19124. * I = 0 ;
  19125. * IMAX = 50 ;
  19126. * REPETER BOUCLE IMAX ;
  19127. * I = I + 1 ;
  19128. * PHI = ATG (XLS1 / ((RHO1*(COS THETA1))+ RZERO + DY1_OLD));
  19129. * DY1_NEW = -1. * DRHO1 * ((COS(PHI * NBOB)) - 1.) ;
  19130. * SI ((MAXI (ABS((DY1_NEW - DY1_OLD) / DY1_NEW))) &lt;EG 1.E-6);
  19131. * MESS ' NOMBRE D ITERATIONS DE POINT FIXE : ' I ;
  19132. * QUITTER BOUCLE ;
  19133. * FINSI ;
  19134. * DY1_OLD = DY1_NEW ;
  19135. * FIN BOUCLE ;
  19136. * DY1 = DY1_NEW ;
  19137. * ---
  19138. PHI = ATG (XLS1 / ((RHO1*(COS THETA1))+ RZERO)) ;
  19139. DY1 = -1. * DRHO1 * ((COS(PHI * NBOB)) - 1.) ;
  19140. DY2 = NOMC UY DY1 ;
  19141. LSIN2 = LSIN1 PLUS DY2 ;
  19142. * --- ligne contenant le contour et le sinus utilisee pour le trace
  19143. LSIN2T = LSIN2T ET LSIN2 ;
  19144. *
  19145. * --------- CALCUL DU POINT D'INTERSECTION
  19146. P_1 = LSIN2 POIN INITIAL ;
  19147. *
  19148. REPETER BOUCP 10 ;
  19149. EL_1 = ELEM LSIN2 CONTENANT P_1 ;
  19150. P_11 = POIN 1 EL_1 ;
  19151. P_12 = POIN 2 EL_1 ;
  19152. XV1 = COOR 1 (P_11 MOIN P_12) ;
  19153. YV1 = COOR 2 (P_11 MOIN P_12) ;
  19154. XV2 = (COOR 1 CONTFIN1) - (COOR 1 P_12);
  19155. YV2 = (COOR 2 CONTFIN2) - (COOR 2 P_12);
  19156. DIST =(ABS((YV2 * XV1) - (XV2 * YV1)))/(NORM (P_11 MOIN P_12));
  19157. PL_1 = (DIST POIN MINI) POIN INITIAL ;
  19158. P_1OLD = P_1 ;
  19159. P_1 = LSIN2 POIN PROC PL_1 ;
  19160. * TRAC (CONTFIN1 ET ((P_11 D 1 P_12) COUL ROUG) ET PL_1 ET LSIN2);
  19161. SI (P_1OLD EGA P_1 0.3E-3) ;
  19162. MESS ' >>> ON TROUVE LE POINT D INTERSEC. << ' ;
  19163. LIST PL_1 ;
  19164. QUITTER BOUCP ;
  19165. FINSI ;
  19166. FIN BOUCP ;
  19167. *
  19168. MESS ' ON EST SORTI DE BOUCP ' ;
  19169. X_11 = COOR 1 P_11 ;
  19170. X_12 = COOR 1 P_12 ;
  19171. SI ((X_12 - X_11) >EG 0.) ;
  19172. VEC_1 = P_12 MOIN P_11 ;
  19173. SINON ;
  19174. VEC_1 = P_11 MOIN P_12 ;
  19175. FINSI ;
  19176. YPL1 = COOR 2 PL_1 ;
  19177. XPL1 = COOR 1 PL_1 ;
  19178. * ---- abscisse curviligne de ce point
  19179. XC_PL_1 = MAXI (REDU CHXCURF PL_1) ;
  19180. PYPL1 = PYPL1 ET (PROG XC_PL_1) ;
  19181. PXVE = PXVE ET (PROG (COOR 1 VEC_1)) ;
  19182. PYVE = PYVE ET (PROG (COOR 2 VEC_1)) ;
  19183. PLAM = PLAM ET (PROG (RPLASMA - RHO1)) ;
  19184. FIN BOUCL ;
  19185. *
  19186. *---- traitement du dernier point du contour
  19187. POINFIN = (INVE CONT1) POIN FINAL ;
  19188. XC_FIN = MAXI (REDU CHXCUR POINFIN) ;
  19189. PYPL1 = PYPL1 ET (PROG (XC_FIN + (XC_FIN/10.))) ;
  19190. PXVE = PXVE ET (PROG 1.E-3) ;
  19191. PYVE = PYVE ET (PROG 0.) ;
  19192. DYMAX = -1. * (MAXI(ABS(YCONT1))) ;
  19193. PLAM = PLAM ET (PROG DYMAX) ;
  19194. *
  19195. *------ Trace du contour et des lignes de champ
  19196. TITRE ' ENVELOPPES DES LIGNES DE CHAMP ' ;
  19197. TRAC LSIN2T ;
  19198. TITRE 'ABCISSE CURVILIGNE' ;
  19199. DESSIN (EVOL JAUN CHPO CHXCUR SCAL CONT1) MIMA ;
  19200. CHXVE = NOMC SCAL (IPOL CHXCUR PYPL1 PXVE) ;
  19201. CHYVE = NOMC SCAL (IPOL CHXCUR PYPL1 PYVE) ;
  19202. TITRE 'BETA' ;
  19203. BETA = ATG CHYVE CHXVE ;
  19204. DESSIN (EVOL JAUN CHPO BETA SCAL CONT1) MIMA ;
  19205. TITRE 'DISTANCE' ;
  19206. CHDEL = NOMC SCAL (IPOL CHXCUR PYPL1 PLAM) ;
  19207. DESSIN (EVOL JAUN CHPO CHDEL SCAL CONT1) MIMA ;
  19208. *
  19209. *--------------- VARIABLES DE SORTIE :
  19210. TAB1.<BETA = BETA ;
  19211. TAB1.<DIST = CHDEL ;
  19212. *------------------------------------
  19213. *
  19214. SAUT 2 LIGNE ;
  19215. MESS ' ********** FIN DE LA PROCEDURE @RIPPL ***********' ;
  19216. FINPROC ;
  19217. *
  19218. DEBPROC @RIPPL TAB1*TABLE ;
  19219. *
  19220. ***********************************************************
  19221. * Version amelioree de l'ancienne procedure RIPPLE *
  19222. * Alain MOAL (mai 1995) *
  19223. ***********************************************************
  19224. *
  19225. OPTI ECHO 1 ;
  19226. SAUT 2 LIGNE ;
  19227. MESS ' ********** DEBUT DE LA PROCEDURE @RIPPL ***********' ;
  19228. *
  19229. *--------------- VARIABLES D'ENTREE :
  19230. RHO0 = TAB1.<RPLASMA ;
  19231. RPLASMA = TAB1.<RPLASMA ;
  19232. THETA2 = TAB1.<THETA2 ;
  19233. THETA1 = TAB1.<THETA1 ;
  19234. COEF_A1 = TAB1.<COEF_A1 ;
  19235. COEF_B1 = TAB1.<COEF_B1 ;
  19236. COEF_C1 = TAB1.<COEF_C1 ;
  19237. RZERO = TAB1.<R0 ;
  19238. RREF = TAB1.<RREF ;
  19239. CONT1 = TAB1.<CONT ;
  19240. LSIN2T = TAB1.<CONTFIN ;
  19241. CONTFIN1 = TAB1.<CONTFIN ;
  19242. PRHO = TAB1.<PRHO ;
  19243. POINTTOP = TAB1.<PTOP ;
  19244. *------------------------------------
  19245. *---- nombre de bobines
  19246. NBOB = 18. ;
  19247. *
  19248. *---- l'utilite de ce masque ne m'apparait pas clairement
  19249. MASC1 = PRHO MASQUE EGSUPE (RPLASMA - 1.E-3) ;
  19250. PRHO1 = PROG ;
  19251. PDRHO1 = PROG ;
  19252. PRHO2 = PROG ;
  19253. PDRHO2 = PROG ;
  19254. *
  19255. *---- coordonnees polaires dans Rref de l'enveloppe des lignes
  19256. *---- de champ dans le plan Phi = 0
  19257. PRHO2 = ((RPLASMA * MASC1 * (SIN(THETA1)) / (SIN(THETA2))) + ((PRHO - (RPLASMA * MASC1)) / (COS(THETA1 - THETA2)))) ;
  19258. *
  19259. *---- demi-excursion radiale dans Rref
  19260. PDRHO2 = COEF_A1 * (EXP(COEF_B1 *PRHO2)) * (EXP(-1. * COEF_C1 * ((THETA2)**2))) ;
  19261. *
  19262. *---- coordonnees polaires dans Rzero de l'enveloppe des lignes
  19263. *---- de champ dans le plan Phi = 0
  19264. PRHO1 = (((((RREF - RZERO)**2) * MASC1) + (2 * (COS(THETA2)) * (RREF - RZERO) * PRHO2) + ((PRHO2)**2))**0.5) ;
  19265. *
  19266. *---- demi-excursion radiale dans Rzero
  19267. PDRHO1 = (PRHO2 + (MASC1 * (COS(THETA2)) * (RREF - RZERO))) / PRHO1 * PDRHO2 ;
  19268. *---- demi-excursion radiale dans Rzero
  19269. *TEST*PDRHO1 = (PRHO2 + (MASC1 * (COS(THETA2)) * (RREF - RZERO))) /
  19270. *TEST* PRHO * PDRHO2 ;
  19271. *
  19272. *LIST PRHO1 ;
  19273. *LIST PDRHO1 ;
  19274. *
  19275. *---- coordonnees des noeuds du contour
  19276. XCONT1 = COOR 1 CONT1 ;
  19277. YCONT1 = COOR 2 CONT1 ;
  19278. XCONTF1 = COOR 1 CONTFIN1 ;
  19279. YCONTF1 = COOR 2 CONTFIN1 ;
  19280. *
  19281. *---- on doit utiliser un contour constitue de segments a
  19282. *---- 2 noeuds pour le calcul des abcisses curvilignes
  19283. CONT2 = CHAN SEG2 CONT1 ;
  19284. CONTFIN2 = CHAN SEG2 CONTFIN1 ;
  19285. *
  19286. *---- abscisse curviligne pour chaque noeud du contour
  19287. XCUR = EXTR (EVOL CHPO XCONT1 SCAL (INVE CONT1)) ABSC ;
  19288. XCURF = EXTR (EVOL CHPO XCONTF1 SCAL (INVE CONTFIN1)) ABSC ;
  19289. *
  19290. *---- creation du champ a partir de la liste de reels
  19291. CHXCUR = MANU CHPO (INVE CONT2) 1 SCAL XCUR ;
  19292. CHXCURF = MANU CHPO (INVE CONTFIN2) 1 SCAL XCURF ;
  19293. *
  19294. *---- recherche du point extreme en X du contour on suppose
  19295. *---- qu'il est unique et que tous les X sont positifs
  19296. XEXT = MAXI (XCONT1) ;
  19297. PEXT = (XCONT1 POIN MAXI) POIN INITIAL ;
  19298. YEXT = COOR 2 PEXT ;
  19299. *
  19300. LAM0 = RPLASMA - RHO0 ;
  19301. PLAM = PROG LAM0 ;
  19302. PYPL1 = PROG 0. ;
  19303. PXVE = PROG 1.E-3 ;
  19304. PYVE = PROG 0. ;
  19305. I1 = 0 ;
  19306. *
  19307. *---- Pour chaque enveloppe de ligne de champ
  19308. REPETER BOUCL (DIME PRHO1) ;
  19309. I1 = I1 + 1 ;
  19310. *TEST* RHO1 = EXTR I1 PRHO ;
  19311. RHO1 = EXTR I1 PRHO1 ;
  19312. DRHO1 = EXTR I1 PDRHO1 ;
  19313. * MESS 'DRHO1 ' DRHO1 ;
  19314. DENS 3.E-3 ;
  19315. * --- Creation de la ligne de champ
  19316. S1 = 0. (RPLASMA - RHO1) ;
  19317. S2 = (XEXT + (XEXT/10.)) (RPLASMA - RHO1) ;
  19318. LSIN1 = S1 D S2 ;
  19319. XLS1 = COOR 1 LSIN1 ;
  19320. * --- ancien calcul : valable si THETA1 est proche de 90 degres
  19321. * DY1 = -1. * DRHO1 *
  19322. * (COS(XLS1 * (NBOB / RZERO / 3.14159 * 180.)) - 1.) ;
  19323. * --- calcul dans le cas general
  19324. * --- determination iterative de Phi et DY1
  19325. * DY1_OLD = -1. * DRHO1 ;
  19326. * I = 0 ;
  19327. * IMAX = 50 ;
  19328. * REPETER BOUCLE IMAX ;
  19329. * I = I + 1 ;
  19330. * PHI = ATG (XLS1 / ((RHO1*(COS THETA1))+ RZERO + DY1_OLD));
  19331. * DY1_NEW = -1. * DRHO1 * ((COS(PHI * NBOB)) - 1.) ;
  19332. * SI ((MAXI (ABS((DY1_NEW - DY1_OLD) / DY1_NEW))) &lt;EG 1.E-6);
  19333. * MESS ' NOMBRE D ITERATIONS DE POINT FIXE : ' I ;
  19334. * QUITTER BOUCLE ;
  19335. * FINSI ;
  19336. * DY1_OLD = DY1_NEW ;
  19337. * FIN BOUCLE ;
  19338. * DY1 = DY1_NEW ;
  19339. * ---
  19340. PHI = ATG (XLS1 / ((RHO1*(COS THETA1))+ RZERO)) ;
  19341. DY1 = -1. * DRHO1 * ((COS(PHI * NBOB)) - 1.) ;
  19342. DY2 = NOMC UY DY1 ;
  19343. LSIN2 = LSIN1 PLUS DY2 ;
  19344. * --- ligne contenant le contour et le sinus utilisee pour le trace
  19345. LSIN2T = LSIN2T ET LSIN2 ;
  19346. *
  19347. * --------- CALCUL DU POINT D'INTERSECTION
  19348. P_1 = LSIN2 POIN INITIAL ;
  19349. *
  19350. REPETER BOUCP 10 ;
  19351. EL_1 = ELEM LSIN2 CONTENANT P_1 ;
  19352. P_11 = POIN 1 EL_1 ;
  19353. P_12 = POIN 2 EL_1 ;
  19354. XV1 = COOR 1 (P_11 MOIN P_12) ;
  19355. YV1 = COOR 2 (P_11 MOIN P_12) ;
  19356. XV2 = (COOR 1 CONTFIN1) - (COOR 1 P_12);
  19357. YV2 = (COOR 2 CONTFIN2) - (COOR 2 P_12);
  19358. DIST =(ABS((YV2 * XV1) - (XV2 * YV1)))/(NORM (P_11 MOIN P_12));
  19359. PL_1 = (DIST POIN MINI) POIN INITIAL ;
  19360. P_1OLD = P_1 ;
  19361. P_1 = LSIN2 POIN PROC PL_1 ;
  19362. * TRAC (CONTFIN1 ET ((P_11 D 1 P_12) COUL ROUG) ET PL_1 ET LSIN2);
  19363. SI (P_1OLD EGA P_1 0.3E-3) ;
  19364. MESS ' >>> ON TROUVE LE POINT D INTERSEC. << ' ;
  19365. LIST PL_1 ;
  19366. QUITTER BOUCP ;
  19367. FINSI ;
  19368. FIN BOUCP ;
  19369. *
  19370. MESS ' ON EST SORTI DE BOUCP ' ;
  19371. X_11 = COOR 1 P_11 ;
  19372. X_12 = COOR 1 P_12 ;
  19373. SI ((X_12 - X_11) >EG 0.) ;
  19374. VEC_1 = P_12 MOIN P_11 ;
  19375. SINON ;
  19376. VEC_1 = P_11 MOIN P_12 ;
  19377. FINSI ;
  19378. YPL1 = COOR 2 PL_1 ;
  19379. XPL1 = COOR 1 PL_1 ;
  19380. * ---- abscisse curviligne de ce point
  19381. XC_PL_1 = MAXI (REDU CHXCURF PL_1) ;
  19382. PYPL1 = PYPL1 ET (PROG XC_PL_1) ;
  19383. PXVE = PXVE ET (PROG (COOR 1 VEC_1)) ;
  19384. PYVE = PYVE ET (PROG (COOR 2 VEC_1)) ;
  19385. PLAM = PLAM ET (PROG (RPLASMA - RHO1)) ;
  19386. FIN BOUCL ;
  19387. *
  19388. *---- traitement du dernier point du contour
  19389. POINFIN = (INVE CONT1) POIN FINAL ;
  19390. XC_FIN = MAXI (REDU CHXCUR POINFIN) ;
  19391. PYPL1 = PYPL1 ET (PROG (XC_FIN + (XC_FIN/10.))) ;
  19392. PXVE = PXVE ET (PROG 1.E-3) ;
  19393. PYVE = PYVE ET (PROG 0.) ;
  19394. DYMAX = -1. * (MAXI(ABS(YCONT1))) ;
  19395. PLAM = PLAM ET (PROG DYMAX) ;
  19396. *
  19397. *------ Trace du contour et des lignes de champ
  19398. TITRE ' ENVELOPPES DES LIGNES DE CHAMP ' ;
  19399. TRAC LSIN2T ;
  19400. TITRE 'ABCISSE CURVILIGNE' ;
  19401. DESSIN (EVOL JAUN CHPO CHXCUR SCAL CONT1) MIMA ;
  19402. CHXVE = NOMC SCAL (IPOL CHXCUR PYPL1 PXVE) ;
  19403. CHYVE = NOMC SCAL (IPOL CHXCUR PYPL1 PYVE) ;
  19404. TITRE 'BETA' ;
  19405. BETA = ATG CHYVE CHXVE ;
  19406. DESSIN (EVOL JAUN CHPO BETA SCAL CONT1) MIMA ;
  19407. TITRE 'DISTANCE' ;
  19408. CHDEL = NOMC SCAL (IPOL CHXCUR PYPL1 PLAM) ;
  19409. DESSIN (EVOL JAUN CHPO CHDEL SCAL CONT1) MIMA ;
  19410. *
  19411. *--------------- VARIABLES DE SORTIE :
  19412. TAB1.<BETA = BETA ;
  19413. TAB1.<DIST = CHDEL ;
  19414. *------------------------------------
  19415. *
  19416. SAUT 2 LIGNE ;
  19417. MESS ' ********** FIN DE LA PROCEDURE @RIPPL ***********' ;
  19418. FINPROC ;
  19419. debproc @RMCOOR tab1*table ;
  19420.  
  19421. *
  19422. * R. Mitteau etude interseption
  19423. * 25/08/1998
  19424. *
  19425. mess '---------------------------------> calling @RMCOOR';
  19426. *
  19427. * --- variables d entree :
  19428. *
  19429. mail1 = tab1.<maillage ;
  19430.  
  19431.  
  19432. * RM25/08/98 la il faudrait mettre un test pour verfier qu'on
  19433. * entre bien un maillage surfacique compose uniquement de tri3
  19434.  
  19435. *chpo des coordonnee des noeuds
  19436. chx1 = coor 1 mail1 ;
  19437. chy1 = coor 2 mail1 ;
  19438. chz1 = coor 3 mail1 ;
  19439.  
  19440. mod1 = MODE mail1 mecanique elastique ;
  19441. *cham des coordonnees des noeuds
  19442. cex1 = chan cham chx1 mod1 noeud ;
  19443. cey1 = chan cham chy1 mod1 noeud ;
  19444. cez1 = chan cham chz1 mod1 noeud ;
  19445.  
  19446. nel1 = nbel mail1 ;
  19447. mess '>@RMCOOR> construction des champs de coordonnees sur les ' nel1 ' elements';
  19448. * initialisation
  19449. chamx1 = manu chml mod1 scal 0. stresses type scalaire ;
  19450. chamx2 = manu chml mod1 scal 0. stresses type scalaire ;
  19451. chamx3 = manu chml mod1 scal 0. stresses type scalaire ;
  19452. chamy1 = manu chml mod1 scal 0. stresses type scalaire ;
  19453. chamy2 = manu chml mod1 scal 0. stresses type scalaire ;
  19454. chamy3 = manu chml mod1 scal 0. stresses type scalaire ;
  19455. chamz1 = manu chml mod1 scal 0. stresses type scalaire ;
  19456. chamz2 = manu chml mod1 scal 0. stresses type scalaire ;
  19457. chamz3 = manu chml mod1 scal 0. stresses type scalaire ;
  19458.  
  19459. repe boucel1 nel1 ;
  19460. * mess &boucel1 ;
  19461.  
  19462. cex1_1 = extr cex1 scal 1 &boucel1 1 ;
  19463. cex1_2 = extr cex1 scal 1 &boucel1 2 ;
  19464. cex1_3 = extr cex1 scal 1 &boucel1 3 ;
  19465.  
  19466. cey1_1 = extr cey1 scal 1 &boucel1 1 ;
  19467. cey1_2 = extr cey1 scal 1 &boucel1 2 ;
  19468. cey1_3 = extr cey1 scal 1 &boucel1 3 ;
  19469.  
  19470. cez1_1 = extr cez1 scal 1 &boucel1 1 ;
  19471. cez1_2 = extr cez1 scal 1 &boucel1 2 ;
  19472. cez1_3 = extr cez1 scal 1 &boucel1 3 ;
  19473.  
  19474. chamx1 = chamx1 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_1);
  19475. chamx2 = chamx2 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_2);
  19476. chamx3 = chamx3 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_3);
  19477.  
  19478. chamy1 = chamy1 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_1);
  19479. chamy2 = chamy2 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_2);
  19480. chamy3 = chamy3 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_3);
  19481.  
  19482. chamz1 = chamz1 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_1);
  19483. chamz2 = chamz2 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_2);
  19484. chamz3 = chamz3 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_3);
  19485. fin boucel1 ;
  19486. *
  19487. * --- variables de sortie
  19488. *
  19489. tab1.<chamx1 = chamx1 ;
  19490. tab1.<chamy1 = chamy1 ;
  19491. tab1.<chamz1 = chamz1 ;
  19492. tab1.<chamx2 = chamx2 ;
  19493. tab1.<chamy2 = chamy2 ;
  19494. tab1.<chamz2 = chamz2 ;
  19495. tab1.<chamx3 = chamx3 ;
  19496. tab1.<chamy3 = chamy3 ;
  19497. tab1.<chamz3 = chamz3 ;
  19498.  
  19499.  
  19500. mess '---------------------------------> exiting @RMCOOR';
  19501. finproc ;
  19502.  
  19503. **** @RMCOORO
  19504.  
  19505. debproc @RMCOORO tab1*table ;
  19506.  
  19507. *
  19508. * R. Mitteau etude interseption
  19509. * 25/08/1998
  19510. *
  19511. mess '---------------------------------> calling @RMCOORO';
  19512. *
  19513. * --- variables d entree :
  19514. *
  19515. mail1 = tab1.<maillage ;
  19516.  
  19517.  
  19518. * RM25/08/98 la il faudrait mettre un test pour verifier qu'on
  19519. * entre bien un maillage surfacique compose uniquement de tri3
  19520.  
  19521. * chpo des coordonnee des noeuds dans le repere du maillage
  19522. chxm1 = coor 1 mail1 ;
  19523. chym1 = coor 2 mail1 ;
  19524. chzm1 = coor 3 mail1 ;
  19525.  
  19526. * passage au repere global
  19527. chxg1 chyg1 chzg1 = @crmgc chxm1 chym1 chzm1 tab1;
  19528.  
  19529. mod1 = MODE mail1 mecanique elastique ;
  19530. * cham des coordonnees des noeuds
  19531. cex1 = chan cham chxg1 mod1 noeud ;
  19532. cey1 = chan cham chyg1 mod1 noeud ;
  19533. cez1 = chan cham chzg1 mod1 noeud ;
  19534.  
  19535. nel1 = nbel mail1 ;
  19536. mess '>@RMCOORO> construction des champs de coordonnees sur les ' nel1 ' elements';
  19537. * initialisation
  19538. chamx1 = manu chml mod1 scal 0. stresses type scalaire ;
  19539. chamx2 = manu chml mod1 scal 0. stresses type scalaire ;
  19540. chamx3 = manu chml mod1 scal 0. stresses type scalaire ;
  19541. chamy1 = manu chml mod1 scal 0. stresses type scalaire ;
  19542. chamy2 = manu chml mod1 scal 0. stresses type scalaire ;
  19543. chamy3 = manu chml mod1 scal 0. stresses type scalaire ;
  19544. chamz1 = manu chml mod1 scal 0. stresses type scalaire ;
  19545. chamz2 = manu chml mod1 scal 0. stresses type scalaire ;
  19546. chamz3 = manu chml mod1 scal 0. stresses type scalaire ;
  19547.  
  19548. repe boucel1 nel1 ;
  19549.  
  19550. cex1_1 = extr cex1 scal 1 &boucel1 1 ;
  19551. cex1_2 = extr cex1 scal 1 &boucel1 2 ;
  19552. cex1_3 = extr cex1 scal 1 &boucel1 3 ;
  19553.  
  19554. cey1_1 = extr cey1 scal 1 &boucel1 1 ;
  19555. cey1_2 = extr cey1 scal 1 &boucel1 2 ;
  19556. cey1_3 = extr cey1 scal 1 &boucel1 3 ;
  19557.  
  19558. cez1_1 = extr cez1 scal 1 &boucel1 1 ;
  19559. cez1_2 = extr cez1 scal 1 &boucel1 2 ;
  19560. cez1_3 = extr cez1 scal 1 &boucel1 3 ;
  19561.  
  19562. chamx1 = chamx1 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_1);
  19563. chamx2 = chamx2 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_2);
  19564. chamx3 = chamx3 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_3);
  19565.  
  19566. chamy1 = chamy1 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_1);
  19567. chamy2 = chamy2 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_2);
  19568. chamy3 = chamy3 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_3);
  19569.  
  19570. chamz1 = chamz1 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_1);
  19571. chamz2 = chamz2 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_2);
  19572. chamz3 = chamz3 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_3);
  19573. fin boucel1 ;
  19574. *
  19575. * --- variables de sortie
  19576. *
  19577. tab1.<chamx1 = chamx1 ;
  19578. tab1.<chamy1 = chamy1 ;
  19579. tab1.<chamz1 = chamz1 ;
  19580. tab1.<chamx2 = chamx2 ;
  19581. tab1.<chamy2 = chamy2 ;
  19582. tab1.<chamz2 = chamz2 ;
  19583. tab1.<chamx3 = chamx3 ;
  19584. tab1.<chamy3 = chamy3 ;
  19585. tab1.<chamz3 = chamz3 ;
  19586.  
  19587.  
  19588. mess '---------------------------------> exiting @RMCOORO';
  19589. finproc ;
  19590.  
  19591. **** @RMFLUN
  19592.  
  19593. debproc @RMFLUN tab1*table ;
  19594. ************************************************************
  19595. * Procedure de calcul du flux normalise en chaque noeud de *
  19596. * chaque facette triangulaire d'un maillage (methode *
  19597. * inspiree de @RMCOORO). Alain MOAL (Fevrier 2001) *
  19598. ************************************************************
  19599.  
  19600. mess '---------------------------------> calling @RMFLUN';
  19601. *
  19602. * --- variables d entree :
  19603. FLUN0 = TAB1.<FLUX_NORMALISE ;
  19604. MAIL1 = TAB1.<MAILLAGE ;
  19605. * ------------------------
  19606.  
  19607. mod1 = MODE mail1 mecanique elastique ;
  19608. * --- cham du flux normalise
  19609. cef0 = chan cham FLUN0 mod1 noeud ;
  19610.  
  19611. nel1 = nbel mail1 ;
  19612. mess '>@RMFLUN> construction du champ de flux normalise sur les ' nel1 ' elements';
  19613. * initialisation
  19614. chamf1 = manu chml mod1 scal 0. stresses type scalaire ;
  19615. chamf2 = manu chml mod1 scal 0. stresses type scalaire ;
  19616. chamf3 = manu chml mod1 scal 0. stresses type scalaire ;
  19617.  
  19618. repe boucel1 nel1 ;
  19619. cef0_1 = extr cef0 scal 1 &boucel1 1 ;
  19620. cef0_2 = extr cef0 scal 1 &boucel1 2 ;
  19621. cef0_3 = extr cef0 scal 1 &boucel1 3 ;
  19622.  
  19623. chamf1 = chamf1 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cef0_1);
  19624. chamf2 = chamf2 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cef0_2);
  19625. chamf3 = chamf3 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cef0_3);
  19626. fin boucel1 ;
  19627. *
  19628. * --- variables de sortie
  19629. tab1.<chamf1 = chamf1 ;
  19630. tab1.<chamf2 = chamf2 ;
  19631. tab1.<chamf3 = chamf3 ;
  19632. *
  19633. mess '---------------------------------> exiting @RMFLUN';
  19634. finproc ;
  19635.  
  19636. **** @RMNORM
  19637. debproc @RMNORM tab1*table ;
  19638.  
  19639. mess '---------------------------------> calling @RMNORM';
  19640. *
  19641. * --- variables d entree :
  19642. *
  19643. si (non (existe tab1 <chamx1)) ;
  19644. @rmcoor tab1;
  19645. finsi ;
  19646.  
  19647. * calcul des normales
  19648.  
  19649. * (on pourrait peut etre utiliser VNORM3D. Mais il faut noter
  19650. * qu on veut ici les normales au centre des facettes et non aux noeuds.
  19651. * On profite du fait qu on a ici que des triangles pour utiliser
  19652. * le produit vectoriel de deux cotes du triangle)
  19653.  
  19654. abx1 = (tab1.<chamx2) - (tab1.<chamx1) ;
  19655. acx1 = (tab1.<chamx3) - (tab1.<chamx1) ;
  19656.  
  19657. aby1 = (tab1.<chamy2) - (tab1.<chamy1) ;
  19658. acy1 = (tab1.<chamy3) - (tab1.<chamy1) ;
  19659.  
  19660. abz1 = (tab1.<chamz2) - (tab1.<chamz1) ;
  19661. acz1 = (tab1.<chamz3) - (tab1.<chamz1) ;
  19662.  
  19663.  
  19664. nx1 = (aby1*acz1) - (abz1*acy1) ;
  19665. ny1 = (abz1*acx1) - (abx1*acz1) ;
  19666. nz1 = (abx1*acy1) - (aby1*acx1) ;
  19667.  
  19668. * normalisation
  19669.  
  19670. nor1 = ((nx1 * nx1) + (ny1 * ny1) + (nz1 * nz1)) ** .5 ;
  19671. si (ega (mini nor1) 0.);
  19672. mess '>>>@RMNORM>>> la norme d une des normales est nulle';
  19673. mess '>>>@RMNORM>>> peut-etre maillage n est pas forme de tri3';
  19674. erre '>>>@RMNORM>>> erreur de maillage';
  19675. finsi ;
  19676. nx2 = nx1 * (nor1 ** -1) ;
  19677. ny2 = ny1 * (nor1 ** -1) ;
  19678. nz2 = nz1 * (nor1 ** -1) ;
  19679.  
  19680. *
  19681. * --- variables de sortie
  19682. *
  19683. tab1.<cosx = nx2 ;
  19684. tab1.<cosy = ny2 ;
  19685. tab1.<cosz = nz2 ;
  19686.  
  19687.  
  19688. mess '---------------------------------> exiting @RMNORM';
  19689. finproc ;
  19690.  
  19691. **** @RPOI
  19692. DEBPROC @RPOI LPOINT*MAILLAGE NPOIN*LISTMOTS LSHAF1*MAILLAGE CPLASMA*POINT >PTG*POINT TAB1*TABLE ;
  19693. LSHAF0 = LSHAF1 ET >PTG ;
  19694. TRAC (LPOINT ET >PTG ET CPLASMA ET LSHAF0) ;
  19695. XM = COOR 1 LSHAF0 ;
  19696. YM = COOR 2 LSHAF0 ;
  19697. ZM = XM * 0. ;
  19698. XG YG ZG = @CRMGC XM YM ZM TAB1 ;
  19699. RHOP THETAP PHIP = @CRGTC XG YG ZG TAB1.<RP TAB1.<HP;
  19700. GRAY PRAY THERAY = @CSHIFT RHOP THETAP PHIP 1 TAB1;
  19701. LIGRAY0 = CPLASMA D 1 >PTG ;
  19702. * MESS 'POINT : >PTG' ;
  19703. LNOM = MOTS 'PTG' ;
  19704. PRAY0 = EXTR PRAY SCAL >PTG ;
  19705. GRAY0 = EXTR GRAY SCAL >PTG ;
  19706. LPR1 = PROG PRAY0;
  19707. LGR1 = PROG GRAY0 ;
  19708. LINC10 = >PTG ;
  19709. CHPR1 = MANU CHPO >PTG 1 SCAL PRAY0 NATURE DISCRET;
  19710. CHGR1 = MANU CHPO >PTG 1 SCAL GRAY0 NATURE DISCRET;
  19711. MESS 'POINT >PTG PRAY0' PRAY0 'GRAY0' GRAY0 ;
  19712. I = 0 ;
  19713. CP1 = CPLASMA ;
  19714. TAN1 = >PTG;
  19715. POI1 = >PTG;
  19716. REPETER BOUC21 10;
  19717. POI1 = POI1 TOUR 2. CP1 ;
  19718. TAN1 = TAN1 D 1 POI1;
  19719. FIN BOUC21 ;
  19720. TAN1 = INVE TAN1 ;
  19721. POI1 = >PTG;
  19722. REPETER BOUC31 10;
  19723. POI1 = POI1 TOUR -2. CP1 ;
  19724. TAN1 = TAN1 D 1 POI1;
  19725. FIN BOUC31 ;
  19726. TAN3 = TAN1 COUL BLEU ;
  19727. TRAC (TAN3 ET (CP1 D 1 >PTG)) ;
  19728. MCO1 = MOTS ROUG ROSE JAUN VERT TURQ BLAN BLEU ;
  19729. REPETER BOUCLE1 (NBNO LPOINT);
  19730. I = I + 1 ;
  19731. POINT0 = LPOINT POIN I ;
  19732. NOMP = NPOIN EXTR I ;
  19733. * MESS 'POINT :' NOMP;
  19734. LNOM = LNOM ET (MOTS NOMP) ;
  19735. GRAY1 = EXTR GRAY SCAL POINT0 ;
  19736. PRAY1 = EXTR PRAY SCAL POINT0 ;
  19737. LPR1 = LPR1 ET (PROG PRAY1) ;
  19738. LGR1 = LGR1 ET (PROG GRAY1) ;
  19739. CHPR1 = CHPR1 ET (MANU CHPO POINT0 1 SCAL PRAY0 NATURE DISCRET);
  19740. CHGR1 = CHGR1 ET (MANU CHPO POINT0 1 SCAL GRAY0 NATURE DISCRET);
  19741.  
  19742. I1 = I - (I / 7 * 7) ;
  19743. * ---- centre du cercle dans le repere du maillage
  19744. CP1 = ((COOR 1 CPLASMA) + (GRAY1-GRAY0)) (COOR 2 CPLASMA);
  19745. LIGRAY1 = (CP1 D 1 POINT0) COUL (MCO1 EXTR I1) ;
  19746. LIGRAY0 = LIGRAY0 ET LIGRAY1 ;
  19747. MESS 'POINT ' NOMP ' PRAY1 ' PRAY1 'GRAY1' GRAY1 ;
  19748.  
  19749. * POINT1 = POINT0;
  19750. TAN1 = POINT0 ;
  19751. POI1 = POINT0 ;
  19752. REPETER BOUC2 10;
  19753. POI2 = POI1 TOUR 2. CP1 ;
  19754. TAN1 = TAN1 D 1 POI2;
  19755. POI1 = POI2 ;
  19756. FIN BOUC2 ;
  19757. * POINT1 = POINT0;
  19758. TAN1 = INVE TAN1 ;
  19759. POI1 = POINT0 ;
  19760. REPETER BOUC3 10;
  19761. POI2 = POI1 TOUR -2. CP1 ;
  19762. TAN1 = TAN1 D 1 POI2;
  19763. POI1 = POI2 ;
  19764. FIN BOUC3 ;
  19765. TAN2 = TAN1 COUL (MCO1 EXTR I1);
  19766. TAN3 = TAN3 ET TAN2;
  19767. TRAC (TAN2 ET (CP1 D 1 POINT0)) ;
  19768. FIN BOUCLE1;
  19769. list LNOM ;
  19770. list LPR1 ;
  19771. list LGR1 ;
  19772. *NTAB CHPR1;
  19773. *NTAB CHGR1;
  19774. FINPROC TAN3 LIGRAY0 ;
  19775.  
  19776. **** @SCHINTE
  19777. DEBPROC @SCHINTE LSIN2*MAILLAGE LPA21*MAILLAGE EPS3*FLOTTANT PP_1/POINT ;
  19778. MESS '-----------------------------------> entree dans @SCHINTE ';
  19779. SI ( NON (EXISTE PP_1 )) ;
  19780. P_1 = LSIN2 POIN INITIAL ;
  19781. SINON ;
  19782. P_1 = LSIN2 POIN PROC PP_1 ;
  19783. FINSI ;
  19784. I__1 = 0 ;
  19785. REPETER BOUCP 10 ;
  19786. I__1 = I__1 + 1 ;
  19787. EPS2 = EPS3 ;
  19788. EL_1 = ELEM LSIN2 CONTENANT P_1 ;
  19789. P_11 = POIN 1 EL_1 ;
  19790. P_12 = POIN 2 EL_1 ;
  19791. * trac ( LPA21 ET ( P_11 D P_12 )) ;
  19792. PL_1 = LPA21 POIN DROIT P_11 P_12 EPS2 ;
  19793. I__2 = 0 ;
  19794. REPETER BOUCI 10 ;
  19795. I__2 = I__2 + 1 ;
  19796. NBP1= NBNO PL_1 ;
  19797. SI (NBP1 >EG 3 ) ;
  19798. EPS2 = EPS2 / 1.7 ;
  19799. * EPS2 = EPS2 / 1.9 ;
  19800. MESS I__1 I__2 ' ** NB PTS , EPS2 : ' NBP1 EPS2 ;
  19801. PL_1 = LPA21 POIN DROIT P_11 P_12 EPS2 ;
  19802. SINON ;
  19803. QUITTER BOUCI ;
  19804. FINSI ;
  19805. FIN BOUCI ;
  19806. NBP1= NBNO PL_1 ;
  19807. PL_1 = PL_1 POIN 1 ;
  19808. P_1OLD = P_1 ;
  19809. P_1 = LSIN2 POIN PROC PL_1 ;
  19810. SI ( P_1OLD EGA P_1 0.3E-3 ) ;
  19811. MESS '@SCHINTE >>> ON TROUVE LE POINT D INTERSEC. << ' ;
  19812. LIST PL_1 ;
  19813. QUITTER BOUCP ;
  19814. FINSI ;
  19815. FIN BOUCP ;
  19816. MESS '@SCHINTE>> ON EST SORTI DE BOUCP ' ;
  19817. * P_12 MOIN P_11 EST LA TANGENTE ;
  19818. X_11 = COOR 1 P_11 ;
  19819. X_12 = COOR 1 P_12 ;
  19820. SI ( (X_12 - X_11) >EG 0. ) ;
  19821. VEC_1 = P_12 MOIN P_11 ;
  19822. SINON ;
  19823. VEC_1 = P_11 MOIN P_12 ;
  19824. FINSI ;
  19825. MESS '-----------------------------------> sortie de @SCHINTE ';
  19826. FINPROC PL_1 VEC_1 ;
  19827.  
  19828. DEBPROC @SHIFT RHO*CHPOINT THETA*CHPOINT PHI*CHPOINT TAB1*TABLE ;
  19829. *
  19830. **************************************************************
  19831. * Procedure de calcul des grand et petit rayons du "cercle *
  19832. * de Shafranov" en chaque point defini dans le repere centre *
  19833. * sur le plasma. Alain MOAL (juin 1995) *
  19834. **************************************************************
  19835. *
  19836. OPTI ECHO 0 ;
  19837. *
  19838. *--------------- VARIABLES D'ENTREE :
  19839. RP = TAB1.<RP ;
  19840. RHO0 = TAB1.<RHO0 ;
  19841. LAMB = TAB1.<LAMB ;
  19842. *------------------------------------
  19843. *
  19844. *---- on se ramene a la resolution d'une equation du 2nd degre
  19845. *---- variables auxiliaires
  19846. AUX1 = 1. + LAMB ;
  19847. AUX2 = RHO * (COS THETA) + RP ;
  19848. AUX3 = RHO * (SIN THETA) ;
  19849. DELTA = ((AUX2**2) * (AUX1**2)) - ((AUX1 + 1.) * ( ((AUX2**2) + (AUX3**2)) * AUX1 - (RP**2) - ((RHO0**2) * AUX1))) ;
  19850. *
  19851. *---- deux cercles possibles
  19852. GRANDR1 = ((AUX2 * AUX1) + (DELTA**0.5))/(AUX1 + 1.) ;
  19853. GRANDR2 = ((AUX2 * AUX1) - (DELTA**0.5))/(AUX1 + 1.) ;
  19854. *
  19855. *---- choix du bon cercle
  19856. SI ((COS THETA) >EG 0.) ;
  19857. GRANDR = GRANDR2 ;
  19858. SINON ;
  19859. GRANDR = GRANDR1 ;
  19860. FINSI ;
  19861. *
  19862. *---- calcul du petit rayon
  19863. PETITR = ((AUX2 - GRANDR)**2 + (AUX3**2))**0.5 ;
  19864. *
  19865. *---- calcul de theta dans le repere centre sur le cercle calcule
  19866. THETAR = ATG AUX3 (AUX2 - GRANDR) ;
  19867. *
  19868. FINPROC GRANDR PETITR THETAR;
  19869. **** @TABEAU
  19870. *********************************************************
  19871. ****** PROCEDURE @TABEAU ******
  19872. *********************************************************
  19873. * CARACTERISTIQUES DE L EAU
  19874. *--------------------------------------------------------
  19875. DEBPROC @TABEAU L_TRAC/LOGIQUE TAB_1*TABLE ;
  19876. SI ( NON ( EXISTE L_TRAC )) ;
  19877. L_TRAC = FAUX ;
  19878. FINSI ;
  19879. *
  19880. *
  19881. *--- PARAMETRES
  19882. *
  19883. * ORIGINE : Properties of Water and Steam in SI-Units
  19884. * prepared by Ernst Schmidt ( 0-800C / 0-1000 bar)
  19885. * edited by Ulrich Grigull 1979
  19886. *
  19887. *--- TSAT (C) EN FONCTION DE LA PRESSION (Pa)
  19888. *
  19889. PPSAT = PROG 1.E5 3.E5 6.E5 8.E5 10.E5 15.5E5 19.8E5 24.E5 28.E5 30.E5 32.E5 34.E5 36.E5 40.E5 60.E5 ;
  19890. PTSAT = PROG 99.6 133.5 158.8 170.4 179.9 199.8 212. 221.8 230. 233.8 237.4 240.9 244.1 250.3 275.5 ;
  19891. TAB_1 . EPTSAT = EVOL MANU 'PRESSION' PPSAT 'TEMPERATURE' PTSAT ;
  19892. *
  19893. *--- LISTE DES TEMPERATURES DE SATURATION (C)
  19894. *
  19895. PTSAT = PROG 0. 20. 40. 60. 80. 100. 120. 140. 160. 180. 200. 220. 240. 260. 280. 300. ;
  19896. *
  19897. *--- LISTE DES TEMPERATURES (C)
  19898. *
  19899. PTEMP = PROG 0. 20. 40. 60. 80. 100. 120. 140. 160. 180. 200. 220. 240. 260. 280. 300. ;
  19900. *
  19901. *--- RHO DE L'EAU (kg/m3) EN FONCTION DE LA TEMPERATURE
  19902. *
  19903. PRHOF = PROG 999.8 998.3 992.3 983.2 971.6 958.1 942.9 925.8 907.3 886.9 864.7 840.3 813.6 783.9 750.5 712.2 ;
  19904. TAB_1 . ETRHOF = EVOL MANU 'TEMPERATURE' PTEMP 'MASSEVOLUM' PRHOF ;
  19905. *
  19906. *--- RHO DE LA VAPEUR(kg/m3) A TSAT PSAT EN FONCTION DE TSAT
  19907. *
  19908. PRHOG = PROG 0.005 0.017 0.05 0.13 0.29 0.60 1.12 1.97 3.26 5.16 7.86 11.62 16.76 23.73 33.19 46.19 ;
  19909. TAB_1 . ETRHOG = EVOL MANU 'TEMPERATURE' PTSAT 'MASSEVOLUM' PRHOG ;
  19910. *
  19911. *--- ENTHALPIE DE L'EAU (J/kg) EN FONCTION DE LA TEMPERATURE
  19912. *
  19913. PHF = PROG 0. 83.86E3 167.45E3 251.09E3 334.92E3 419.06E3 503.72E3 589.1E3 675.5E3 763.1E3 852.4E3 943.7E3 1037.6E3 1134.9E3 1236.8E3 1345.E3 ;
  19914. TAB_1 . ETHF = EVOL MANU 'TEMPERATURE' PTEMP 'ENTHALPIE' PHF ;
  19915. TAB_1 . EHFT = EVOL MANU 'ENTHALPIE' PHF 'TEMPERATURE' PTEMP ;
  19916. *
  19917. *--- CHALEUR LATENTE DE VAP. DE L'EAU (J/kg) EN FONCTION DE LA TEMP.
  19918. * ;
  19919. PHFG = PROG 250.2E4 245.4E4 240.7E4 235.9E4 230.9E4 225.7E4 220.2E4 214.4E4 208.1E4 201.3E4 193.9E4 185.6E4 176.5E4 166.1E4 154.4E4 140.6E4;
  19920. TAB_1 . ETHFG = EVOL MANU 'TEMPERATURE' PTEMP 'CH_L_VAP' PHFG ;
  19921. *
  19922. *--- ENTHALPIE DE LA VAPEUR (J/kg) A TSAT PSAT EN FONCTION DE TSAT
  19923. *
  19924. PHG = PHFG + PHF ;
  19925. TAB_1 . ETHG = EVOL MANU 'TEMPERATURE' PTSAT 'ENTH_VAPEUR' PHG ;
  19926. *
  19927. *--- TENSION SURFACIQUE (kg/m2s2) EN FONCTION DE LA TEMPERATURE
  19928. *
  19929. PSIGM = PROG 75.64E-3 72.75E-3 69.60E-3 66.24E-3 62.67E-3 58.91E-3 54.96E-3 50.85E-3 46.58E-3 42.19E-3 37.69E-3 33.10E-3 28.42E-3 23.67E-3 18.94E-3 14.3E-3;
  19930. TAB_1 . ETSIGM = EVOL MANU 'TEMPERATURE' PTEMP 'TENS_SURF' PSIGM ;
  19931. *
  19932. * ORIGINE : Heat Transfer Physical Properties
  19933. * from E.R.G. Eckert and R.M. Drake
  19934. * Analysis of Heat Mass Transfer McGraw-Hill New-York 1972
  19935. *
  19936. *--- LISTE DES TEMPERATURES (C)
  19937. *
  19938. PTEM1 = PROG 0. 20. 40. 60. 80. 100. 120. 140. 160. 180. 200. 220. 240. 260. 280.6 300. ;
  19939. *
  19940. *--- PRANDTL DE L'EAU EN FONCTION DE LA TEMPERATURE
  19941. *
  19942. PPRAF = PROG 13.6 7.02 4.34 3.02 2.22 1.74 1.446 1.241 1.099 1.004 0.937 0.891 0.871 0.874 0.910 1.019 ;
  19943. TAB_1 . ETPRAF = EVOL MANU 'TEMPERATURE' PTEM1 'PRANDTL' PPRAF ;
  19944. *
  19945. *--- VISCOSITE DE L'EAU (kg/ms) EN FONCTION DE LA TEMPERATURE
  19946. *
  19947. PNNU = PROG 1.8E-3 1.E-3 .65E-3 .47E-3 .35E-3 .28E-3 .23E-3 .20E-3 .172E-3 .154E-3 .138E-3 .126E-3 .117E-3 .108E-3 .102E-3 .96E-4 ;
  19948. TAB_1 . ETNNU = EVOL MANU 'TEMPERATURE' PTEM1 'VISCOSITE' PNNU ;
  19949. *
  19950. *--- LAMBDA DE L EAU (W/mK) EN FONCTION DE LA TEMPERATURE
  19951. *
  19952. PLLA = PROG .552 .597 .628 .651 .668 .680 .685 .684 .680 .675 .665 .652 .635 .611 .580 .540 ;
  19953. TAB_1 . ETLLA = EVOL MANU 'TEMPERATURE' PTEM1 'LAMBDA_EAU' PLLA ;
  19954. *
  19955. *--- Cp DE L EAU (J/kg.C) EN FONCTION DE LA TEMPERATURE
  19956. *
  19957. PCPF = PROG 4217.8 4181.8 4178.4 4184.3 4196.4 4216.1 4250 4283 4342 4417 4505 4610 4756 4949 5208 5728 ;
  19958. TAB_1 . ETCPF = EVOL MANU 'TEMPERATURE' PTEM1 'Cp_EAU' PCPF ;
  19959. *
  19960. * ORIGINE : Handbook of Heat Transfer ( McGraw-Hill)
  19961. * Rohsenow and Hartnett ( p 7-5 )
  19962. * Diagramme de Moody
  19963. *
  19964. *--- COEF DE FROTTEMENT EN FONCTION DU NOMBRE DE REYNOLDS
  19965. *--- POUR UNE PAROI LISSE
  19966. *
  19967. PRE = PROG 4.E3 6.E3 9.E3 2.E4 6.E4 1.E5 2.E5 1.E6 3.E6 1.E7 ;
  19968. PCF = PROG 0.01 0.009 0.008 0.006 0.005 0.0045 0.004 0.003 0.0023 0.002 ;
  19969. TAB_1.ETF = EVOL MANU 'REYNOLDS' PRE 'COEFFROT' PCF ;
  19970. *
  19971. SI L_TRAC ;
  19972. DESSIN TAB_1.EPTSAT ;
  19973. DESSIN TAB_1.ETRHOF ;
  19974. DESSIN TAB_1.ETRHOG ;
  19975. DESSIN TAB_1.ETPRAF ;
  19976. DESSIN TAB_1.ETNNU ;
  19977. DESSIN ( TAB_1.ETHF ET TAB_1.ETHG ) ;
  19978. DESSIN ( TAB_1.ETHFG ) ;
  19979. DESSIN TAB_1.ETLLA ;
  19980. DESSIN TAB_1.ETF ;
  19981. FINSI ;
  19982. FINPROC ;
  19983. **** @TESTGEO
  19984.  
  19985. DEBPROC @TESTGEO TAB1*TABLE ;
  19986.  
  19987. MESS '---------------------------------> calling @TESTGEO';
  19988. MESS 'METHODE GEOMETRIQUE' ;
  19989. *
  19990. *--------------- VARIABLES D'ENTREE :
  19991. *
  19992.  
  19993. MAIL1 = TAB1.<S_OMBRE ;
  19994. OMB0 = TAB1.<S_OMBRANT ;
  19995. IMETHOD = TAB1.<METHODE_REMONTEE ;
  19996. chsign1 = tab1.<chsign ;
  19997.  
  19998. TYPCAL = TAB1.<TYPE_CALCUL ;
  19999. RP = TAB1.<RP ;
  20000. RHO0 = TAB1.<RHO0 ;
  20001. RR = TAB1.<RR ;
  20002. HP = TAB1.<HP ;
  20003. EPS0 = TAB1.<EPS ;
  20004. COEFA = TAB1.<COEFA ;
  20005. COEFB = TAB1.<COEFB ;
  20006. COEFC = TAB1.<COEFC ;
  20007. NBOB = TAB1.<NBOB ;
  20008.  
  20009. PASB2 = TAB1.<PAS_AVEC_TEST ;
  20010. DMAX2 = TAB1.<DIST_AVEC_TEST ;
  20011. NBPAS2 = TAB1.<NBPAS2 ;
  20012.  
  20013. SI (EXIS TAB1 <PAS_SANS_TEST) ;
  20014. PASB1 = TAB1.<PAS_SANS_TEST ;
  20015. DMAX1 = TAB1.<DIST_SANS_TEST ;
  20016. NBPAS1 = TAB1.<NBPAS1 ;
  20017. FINSI ;
  20018.  
  20019. SI ((VALEUR DIME) EGA 2) ;
  20020. IPLAN = TAB1.<PLAN ;
  20021. FINSI ;
  20022.  
  20023. SI (EXIS TAB1 <SAUV_PTS_OMBRANTS) ;
  20024. REPO = TAB1.<SAUV_PTS_OMBRANTS ;
  20025. SINON;
  20026. REPO = FAUX;
  20027. FINSI ;
  20028.  
  20029. *
  20030. * ---
  20031. *
  20032.  
  20033. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  20034. ISHIFT = VRAI ;
  20035. IRIPPLE = VRAI ;
  20036. FINSI ;
  20037. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  20038. ISHIFT = VRAI ;
  20039. IRIPPLE = FAUX ;
  20040. FINSI ;
  20041. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  20042. ISHIFT = FAUX ;
  20043. IRIPPLE = VRAI ;
  20044. FINSI ;
  20045. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  20046. ISHIFT = FAUX ;
  20047. IRIPPLE = FAUX ;
  20048. FINSI ;
  20049. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  20050. ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
  20051. FINSI ;
  20052.  
  20053. *xm ym zm = coor omb0 ;
  20054. *xg yg zg = @crmgc xm ym zm tab1 ;
  20055. *rho theta phi = @crgtc xg yg zg rp hp ;
  20056. *rhomax = maxi rho ;
  20057. *rhomin = mini rho ;
  20058. *thetamax = maxi theta ;
  20059. *thetamin = mini theta ;
  20060. *RM22/12/98 le test d'appartenance au domaine de validite du
  20061. * modele de ripple est fait dans ombrage
  20062. *
  20063. * -------------------------------------------------------------
  20064. *
  20065. * --- calcul de l'angle d'incidence maximal s'il n'a pas ete
  20066. * defini par l'utilisateur
  20067. *
  20068. SI (EXIS TAB1 <INCIDENCE_MAXIMALE) ;
  20069. ALPHA = TAB1.<INCIDENCE_MAXIMALE ;
  20070. SINON ;
  20071. ALPHA = @INCI TAB1 ;
  20072. TAB1.<INCIDENCE_MAXIMALE = ALPHA ;
  20073. FINSI ;
  20074. *
  20075. * --- calcul du critere d'intersection s'il n'a pas ete
  20076. * defini par l'utilisateur
  20077. *
  20078. SI (EXIS TAB1 <DELIM) ;
  20079. DELIM = TAB1.<DELIM ;
  20080. SINON ;
  20081. DELIM = @CRIT TAB1 ;
  20082. FINSI ;
  20083. *
  20084. * -------------------------------------------------------------
  20085. *
  20086. * --- DUPLICATION DU MAILLAGE OMBRE NON DEFORME
  20087. SI ((VALEUR DIME) EGA 3) ;
  20088. VNUL = 0. 0. 0. ;
  20089. SINON ;
  20090. VNUL = 0. 0. ;
  20091. FINSI ;
  20092. * --- MAILLAGE DE TRAVAIL => FORM
  20093. MAI1TRAV = MAIL1 PLUS VNUL ;
  20094.  
  20095. *
  20096. * --- PROJECTION DU CHAMP DE SIGNES SUR LE MAILLAGE DE TRAVAIL
  20097. * --- BOUCLE SUR CHAQUE POINT DU MAILLAGE DE TRAVAIL
  20098.  
  20099. MAIL1PT = CHAN MAI1TRAV POI1 ;
  20100. NBM1 = NBNO MAI1TRAV ;
  20101. PT1 = ELEM MAIL1PT POINT 1 ;
  20102. PP = MAIL1 POIN PROC PT1 ;
  20103. VAL1 = EXTR CHSIGN1 SCAL PP ;
  20104. MAILP1 = MANU POI1 PT1 ;
  20105. CHSIGTRA = MANU CHPO MAILP1 1 SCAL VAL1 'NATURE' DISCRET ;
  20106. REPETER BOUPI (NBM1 - 1) ;
  20107. I = &BOUPI + 1 ;
  20108. PTI = ELEM MAIL1PT POINT I ;
  20109. PPI = MAIL1 POIN PROC PTI ;
  20110. VALI = EXTR CHSIGN1 SCAL PPI ;
  20111. MAILPI = MANU POI1 PTI ;
  20112. CHI = MANU CHPO MAILPI 1 SCAL VALI 'NATURE' DISCRET ;
  20113. CHSIGTRA = CHSIGTRA ET CHI ;
  20114. FIN BOUPI ;
  20115. *BR 01/10/98 TAB1.<CHSIGN = CHSIGN ;
  20116. *
  20117. * #######################################################
  20118. *
  20119. *--- INITIALISATION DES PARAMETRES DE LA BOUCLE
  20120. *
  20121. * #######################################################
  20122. *
  20123. I1 = 0 ;
  20124. chelim = manu chpo MAI1TRAV 1 'SCAL' 0. nature discret ;
  20125. CHP1 = MANU CHPO MAI1TRAV 1 'SCAL' 1. NATURE DISCRET ;
  20126. CHDIST = MANU CHPO MAI1TRAV 1 'SCAL' 0. NATURE DISCRET ;
  20127. MASQ1 = CHELIM ;
  20128.  
  20129.  
  20130. * ---- VARIABLE POUR SAVOIR SI ON EFFECTUE LE VISAVIS OU NON
  20131. TVISA = VRAI ;
  20132.  
  20133. * ---- coordonnees dans le repere du maillage
  20134. XM0 = COOR 1 MAI1TRAV ;
  20135. YM0 = COOR 2 MAI1TRAV ;
  20136. DIM0 = VALEUR DIME ;
  20137. SI (DIM0 EGA 2) ;
  20138. ZM0 = XM0 * 0. ;
  20139. DNUL = XM0 * 0. ;
  20140. PHINUL = DNUL ;
  20141. THENUL = DNUL ;
  20142. VNUL = 0. 0. ;
  20143. SINON ;
  20144. ZM0 = COOR 3 MAI1TRAV ;
  20145. VNUL = 0. 0. 0. ;
  20146. FINSI ;
  20147.  
  20148. *---- Coordonnees dans le repere global du tore
  20149. XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
  20150.  
  20151. *---- CONSTRUCTION D'UN POINT REPONDANT AU CRITERE DE VISAVIS
  20152. PVISA = (OMB0 POIN INIT) PLUS VNUL ;
  20153.  
  20154. *---- Repere pour le trace
  20155. SI (DIM0 EGA 3) ;
  20156. repxyz = @REPERE (prog 0.1 0.1 0.1) VRAI rouge;
  20157. FINSI ;
  20158.  
  20159. *---- initialisation des distances
  20160. LCOURAN1 = 0. ;
  20161. LMAX1 = 0. ;
  20162.  
  20163.  
  20164. *
  20165. * --- Rappel des parametres de la procedure
  20166. *
  20167. MESS ' ';
  20168. MESS '##################################################';
  20169. MESS ' ';
  20170. MESS '>@TESTGEO> procedure OMBRAGE, Rappel des parametres de calcul ';
  20171. MESS ' ';
  20172.  
  20173. SI (IMETHOD EGA 1) ;
  20174. METH = 'methode explicite des tangentes';
  20175. FINSI ;
  20176. SI (IMETHOD EGA 2) ;
  20177. METH = 'methode moyenne des tangentes aux extremitee';
  20178. FINSI ;
  20179. SI (IMETHOD EGA 3) ;
  20180. METH = 'methode du point milieu';
  20181. FINSI ;
  20182. SI (IMETHOD EGA 4) ;
  20183. METH = 'methode de reprojection';
  20184. FINSI ;
  20185. MESS ' ';
  20186.  
  20187. SI (EXIS tab1 <PAS_SANS_TEST) ;
  20188. MESS 'Calcul en deux parties :';
  20189. MESS ' ';
  20190. MESS 'SANS TEST';
  20191. MESS 'Distance remontee :' DMAX1 ;
  20192. MESS 'Pas pour la remontee :' PASB1 ;
  20193. MESS 'Nombre d iterations :' NBPAS1 ;
  20194. MESS ' ';
  20195. MESS 'AVEC TEST';
  20196. MESS 'Distance remontee :' DMAX2 ;
  20197. MESS 'Pas pour la remontee :' PASB2 ;
  20198. MESS 'Nombre d iterations :' NBPAS2 ;
  20199. SINON ;
  20200. MESS 'Calcul avec test systematique :';
  20201. MESS 'Distance remontee :' DMAX2 ;
  20202. MESS 'Pas de remontee :' PASB2 ;
  20203. MESS 'Nombre d iterations :' NBPAS2 ;
  20204. FINSI ;
  20205. MESS ' ' ;
  20206. MESS 'Critere d interception pour VISAVIS :' DELIM ;
  20207. MESS 'Incidence maximale sur OMBRE en degres :' ALPHA ;
  20208.  
  20209. SI (EXIS TAB1 <NTRAC) ;
  20210. MESS 'AVEC 'TAB1.<NTRAC' TRACES INTERMEDIAIRES' ;
  20211. FINSI ;
  20212.  
  20213. SI (EXIS TAB1 <SAUV_PTS_OMBRANTS ) ;
  20214. SI TAB1.<SAUV_PTS_OMBRANTS ;
  20215. MESS 'Sauvegarde des points ombrants';
  20216. SINON ;
  20217. MESS 'pas de sauvegarde des points ombrants';
  20218. FINSI ;
  20219. SINON ;
  20220. MESS 'pas de sauvegarde des points ombrants';
  20221. FINSI ;
  20222.  
  20223. SI ISHIFT ;
  20224. MESS 'Calcul avec shift de Safranov' ;
  20225. SINON ;
  20226. MESS 'Calcul sans shift de Safranov';
  20227. FINSI ;
  20228.  
  20229. SI IRIPPLE ;
  20230. MESS 'Calcul avec ripple du champ toroidal' ;
  20231. SINON ;
  20232. MESS 'Calcul sans ripple du champ toroidal' ;
  20233. FINSI ;
  20234.  
  20235. MESS ' ';
  20236. MESS '##################################################';
  20237. MESS ' ';
  20238.  
  20239. SI (EXIS TAB1 <DIST_SANS_TEST) ;
  20240. PAR2 = FAUX ;
  20241. TVISA = FAUX ;
  20242. MESS 'PREMIERE PARTIE DU CALCUL, SANS VISAVIS';
  20243. NBPAS0 = NBPAS1 + NBPAS2 ;
  20244. SINON ;
  20245. NBPAS0 = NBPAS2 ;
  20246. FINSI ;
  20247.  
  20248. *
  20249. *--------------------------------------------------------------
  20250. *
  20251. * DEBUT DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  20252. *
  20253. *--------------------------------------------------------------
  20254. *
  20255. MESS ' ';
  20256. MESS '##################################################';
  20257. MESS ' ';
  20258.  
  20259.  
  20260. SI (EXIS TAB1 <DIST_SANS_TEST) ;
  20261.  
  20262. * ------------------ Boucle 1 on remonte sans test -------------------
  20263. PASB0 = PASB1 ;
  20264. * increment de la distance de connexion (= PAS tant qu'il n'y a pas
  20265. * d'intersection)
  20266. chdist9 = manu chpo MAI1TRAV 1 scal pasb0 ;
  20267.  
  20268. MESS 'PREMIERE PARTIE DU CALCUL, SANS TEST D INTERSECTION';
  20269. REPETER BOUCLE1 NBPAS1 ;
  20270. I1 = I1 + 1 ;
  20271. LCOURAN1 = LCOURAN1 + PASB0 ;
  20272. MESS ' ';
  20273. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  20274.  
  20275. * ---- Appel de la procedure de calcul des deplacements selon methode choisie
  20276. * ---- Methode Explicite
  20277. SI (IMETHOD EGA 1) ;
  20278. DEPX0 DEPY0 DEPZ0 = @DEXPLI XG_OLD YG_OLD ZG_OLD PASB0 TAB1;
  20279. FINSI ;
  20280. * ---- Methode Euler-Cauchy
  20281. SI (IMETHOD EGA 2) ;
  20282. DEPX0 DEPY0 DEPZ0 = @DMOYEN XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
  20283. FINSI ;
  20284. * ---- Methode Point Milieu Modifiee
  20285. SI (IMETHOD EGA 3) ;
  20286. DEPX0 DEPY0 DEPZ0 =@DMILIEU XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
  20287. FINSI ;
  20288. * ---- Methode de Reprojection
  20289. SI (IMETHOD EGA 4) ;
  20290. DEPX0 DEPY0 DEPZ0 =@DREPROJ XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
  20291. FINSI ;
  20292.  
  20293. * ---- On affecte le signe donnant le sens de remontee aux deplacements
  20294. DEPX0 = CHSIGTRA * DEPX0 ;
  20295. DEPY0 = CHSIGTRA * DEPY0 ;
  20296. DEPZ0 = CHSIGTRA * DEPZ0 ;
  20297.  
  20298. * ---- Calcul du deplacement projete selon le cas
  20299. SI (DIM0 EGA 2) ;
  20300. * ---- Calcul de TETA et PHI par @CRGTC
  20301. RHO THETA PHI = @CRGTC XG_OLD YG_OLD ZG_OLD RP HP ;
  20302.  
  20303. * ---- Projection par un double changement de base
  20304. SI (EGA IPLAN 'PHICONS') ;
  20305. DRO DTETA DPHI = @CBGTV DEPX0 DEPY0 DEPZ0 THETA PHI ;
  20306. PHINUL = DNUL ;
  20307. DEPXP DEPYP DEPZP = @CBTGV DRO DTETA DNUL THETA PHINUL;
  20308. SINON ;
  20309. DRO DTETA DPHI = @CBGTV DEPX0 DEPY0 DEPZ0 THETA PHI ;
  20310. THENUL = DNUL ;
  20311. DEPXP DEPYP DEPZP = @CBTGV DRO DNUL DPHI THENUL PHI ;
  20312. FINSI ;
  20313. FINSI ;
  20314.  
  20315. * ---- Cas 3D : Dprojete = D
  20316. SI (DIM0 EGA 3) ;
  20317. DEPXP DEPYP DEPZP = DEPX0 DEPY0 DEPZ0 ;
  20318. FINSI ;
  20319.  
  20320. * ---- On calcule les deplacements (projetes si 2D)
  20321. * ---- dans le repere du maillage pour le FORM
  20322. * ---- avec la procedure de changement de base
  20323. DX DY DZ = @CBGMV DEPXP DEPYP DEPZP TAB1 ;
  20324.  
  20325. DEPX1 = NOMC UX DX NATURE DIFFUS ;
  20326. DEPY1 = NOMC UY DY NATURE DIFFUS ;
  20327. DEPZ1 = NOMC UZ DZ NATURE DIFFUS ;
  20328.  
  20329. DEP1 = DEPX1 ET DEPY1 ET DEPZ1 ;
  20330. FORM DEP1 ;
  20331.  
  20332. * ---- Calcul analytique des nouvelles coordonnees dans le repere global
  20333. * (deplacements non projetes meme en 2D)
  20334.  
  20335. XG_NEW = XG_OLD + DEPX0 ;
  20336. YG_NEW = YG_OLD + DEPY0 ;
  20337. ZG_NEW = ZG_OLD + DEPZ0 ;
  20338.  
  20339. XG_OLD = XG_NEW ;
  20340. YG_OLD = YG_NEW ;
  20341. ZG_OLD = ZG_NEW ;
  20342.  
  20343.  
  20344. *--- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  20345. chdist = chdist + CHDIST9 ;
  20346.  
  20347.  
  20348.  
  20349.  
  20350. * --- actualisation des champs de coordonnees pour iteration suivante
  20351.  
  20352. XG_OLD = XG_NEW ;
  20353. YG_OLD = YG_NEW ;
  20354. ZG_OLD = ZG_NEW ;
  20355.  
  20356. FIN BOUCLE1 ;
  20357. * ------------------------ Fin de la boucle 1 ------------------------
  20358. finsi ;
  20359.  
  20360.  
  20361.  
  20362. MESS ' ';
  20363. MESS '##################################################';
  20364. MESS ' ';
  20365.  
  20366. MESS 'CALCUL AVEC TEST D INTERSECTION';
  20367.  
  20368. * ------------------ Boucle 2 on remonte avec test -------------------
  20369. PASB0 = PASB2 ;
  20370. REPETER BOUCLE2 NBPAS2 ;
  20371.  
  20372. I1 = I1 + 1 ;
  20373. LCOURAN1 = LCOURAN1 + PASB0 ;
  20374. MESS ' ';
  20375. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  20376.  
  20377.  
  20378. *---- Appel de la procedure de calcul des deplacements selon methode choisie
  20379. *---- Methode Explicite
  20380. SI (IMETHOD EGA 1) ;
  20381. DEPX0 DEPY0 DEPZ0 = @DEXPLI XG_OLD YG_OLD ZG_OLD PASB0 TAB1;
  20382. FINSI ;
  20383. *---- Methode Euler-Cauchy
  20384. SI (IMETHOD EGA 2) ;
  20385. DEPX0 DEPY0 DEPZ0 = @DMOYEN XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
  20386. FINSI ;
  20387. *---- Methode Point Milieu Modifiee
  20388. SI (IMETHOD EGA 3) ;
  20389. DEPX0 DEPY0 DEPZ0 = @DMILIEU XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
  20390. FINSI ;
  20391. *---- Methode de Reprojection
  20392. SI (IMETHOD EGA 4) ;
  20393. DEPX0 DEPY0 DEPZ0 = @DREPROJ XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
  20394. FINSI ;
  20395.  
  20396. *---- On affecte le signe donnant le sens de remontee aux deplacements
  20397. DEPX0 = CHSIGTRA * DEPX0 ;
  20398. DEPY0 = CHSIGTRA * DEPY0 ;
  20399. DEPZ0 = CHSIGTRA * DEPZ0 ;
  20400.  
  20401. *---- Calcul du deplacement projete selon le cas
  20402. SI (DIM0 EGA 2) ;
  20403. *---- Calcul de TETA et PHI par @CRGTC
  20404. RHO THETA PHI = @CRGTC XG_OLD YG_OLD ZG_OLD RP HP ;
  20405.  
  20406. *---- Projection par un double changement de base
  20407. SI (EGA IPLAN 'PHICONS') ;
  20408. DRO DTETA DPHI = @CBGTV DEPX0 DEPY0 DEPZ0 THETA PHI ;
  20409. PHINUL = DNUL ;
  20410. DEPXP DEPYP DEPZP = @CBTGV DRO DTETA DNUL THETA PHINUL;
  20411. SINON ;
  20412. DRO DTETA DPHI = @CBGTV DEPX0 DEPY0 DEPZ0 THETA PHI ;
  20413. THENUL = DNUL ;
  20414. DEPXP DEPYP DEPZP = @CBTGV DRO DNUL DPHI THENUL PHI ;
  20415. FINSI ;
  20416. FINSI ;
  20417.  
  20418. *---- Cas 3D : Dprojete = D
  20419. SI (DIM0 EGA 3) ;
  20420. DEPXP DEPYP DEPZP = DEPX0 DEPY0 DEPZ0 ;
  20421. FINSI ;
  20422.  
  20423. * ---- On calcule les deplacements (projetes si 2D)
  20424. * ---- dans le repere du maillage pour le FORM
  20425. * ---- avec la procedure de changement de base
  20426. DX DY DZ = @CBGMV DEPXP DEPYP DEPZP TAB1 ;
  20427.  
  20428. DEPX1 = NOMC UX DX NATURE DIFFUS ;
  20429. DEPY1 = NOMC UY DY NATURE DIFFUS ;
  20430. DEPZ1 = NOMC UZ DZ NATURE DIFFUS ;
  20431.  
  20432. DEP1 = DEPX1 ET DEPY1 ET DEPZ1 ;
  20433. FORM DEP1 ;
  20434.  
  20435. *---- Calcul analytique des nouvelles coordonnees dans le repere global
  20436. * (deplacements non projetes meme en 2D)
  20437.  
  20438. XG_NEW = XG_OLD + DEPX0 ;
  20439. YG_NEW = YG_OLD + DEPY0 ;
  20440. ZG_NEW = ZG_OLD + DEPZ0 ;
  20441.  
  20442. XG_OLD = XG_NEW ;
  20443. YG_OLD = YG_NEW ;
  20444. ZG_OLD = ZG_NEW ;
  20445.  
  20446. *---- test sur les eventuels noeuds interceptes
  20447. *---- SEULEMENT SI NECESSAIRE (D'APRES DEMANDE UTILISATEUR)
  20448. ptest pt2 = visavis (MAI1TRAV et pvisa) omb0 delim;
  20449. si ((nbno ptest) > 1) ;
  20450. pt1 pt2 = visavis MAI1TRAV omb0 delim;
  20451. MESS 'nombre de noeuds interceptes ='(nbno pt1);
  20452. LMAX1 = LCOURAN1 ;
  20453. *
  20454. *--- SAUVEGARDE DES POINTS OMBRANTS CONDITIONEL CAR PREND DU TEMPS CPU
  20455. SI REPO ;
  20456. SI (EGA (TYPE POMB) MAILLAGE);
  20457. POMB = POMB ET PT2 ;
  20458. SINON ;
  20459. POMB = PT2 ;
  20460. FINSI ;
  20461. FINSI ;
  20462. *
  20463. *---- construction du champ contenant 1 aux noeuds
  20464. *---- interceptes a l'iteration courante
  20465. chelim1 = manu chpo pt1 1 'SCAL' 1. nature discret ;
  20466.  
  20467. *---- construction du champ contenant n aux noeuds
  20468. *---- interceptes n fois
  20469. chelim = chelim et chelim1 ;
  20470.  
  20471. *---- CHPOINT CONTENANT DES 1 POUR LES NOEUDS
  20472. *---- INTERCEPTES AU MOINS UNE FOIS
  20473. masq1 = chelim masq 'SUPERIEUR' 0. ;
  20474.  
  20475. * ---- nombre de points interceptes depuis le debut
  20476. * ---- du calcul :
  20477. PTPRIS = masq1 poin superieur 0.;
  20478.  
  20479. * ---- on quitte la boucle si tous les noeuds ont
  20480. * ---- ete interceptes
  20481. SI ((NBNO PTPRIS) EGA (NBNO MAI1TRAV)) ;
  20482. QUITER BOUCLE1 ;
  20483. FINSI ;
  20484. FINSI ;
  20485. *---- fin du test d'interception
  20486.  
  20487. *--- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  20488. chdisti = PASB0 * (CHP1 - MASQ1) ;
  20489. chdisti = chan attribut chdisti nature discret ;
  20490. chdist = chan attribut chdist nature discret ;
  20491. chdist = chdist et chdisti ;
  20492. mess 'mini maxi dist connection en m' (mini (prog lmax1(mini chdist))) lmax1 ;
  20493.  
  20494. * mess 'mini maxi dist connection en m'
  20495. * (mini chdist) (maxi chdist);
  20496.  
  20497.  
  20498. *--- Traces intermediaires si TAB1.<NTRAC specifie
  20499. SI (EXIS TAB1 <NTRAC) ;
  20500. NSORT = NBPAS0 / TAB1.<NTRAC ;
  20501. SI (NSORT EGA 0) ;
  20502. NSORT = 1 ;
  20503. FINSI ;
  20504. OUT = (I1 - (NSORT*(I1/NSORT)));
  20505. SI ( OUT EGA 0);
  20506. *---- CAS 3D
  20507. SI (DIM0 EGA 3) ;
  20508. SI TVISA ;
  20509. SI ((nbno ptest) > 1) ;
  20510. titre 'pas='i1' on trouve'(nbno (pt1)) 'noeuds verifiant le critere';
  20511. trac (0. 1.E+6 0.) ((PT1 COUL ROUG) ET MAI1TRAV ET MAIL1 et repxyz ET OMB0 );
  20512. trac (1.E+6 0. 0.) ((PT1 COUL ROUG) ET MAI1TRAV ET MAIL1 et repxyz ET OMB0 );
  20513. trac (0. 0. 1.E+6) ((PT1 COUL ROUG) ET MAI1TRAV ET MAIL1 et repxyz ET OMB0 );
  20514. SINON ;
  20515. titre 'pas='i1' pas de noeud verifiant le critere';
  20516. trac (0. 1.E+6 0.) ((MAI1TRAV COUL ROUG) ET MAIL1 et repxyz ET OMB0 );
  20517. trac (1.E+6 0. 0.) ((MAI1TRAV COUL ROUG) ET MAIL1 et repxyz ET OMB0 );
  20518. trac (0. 0. 1.E+6) ((MAI1TRAV COUL ROUG) ET MAIL1 et repxyz ET OMB0 );
  20519. FINSI ;
  20520. SINON ;
  20521. titre 'pas='i1' pas de test effectue';
  20522. trac (0. 1.E+6 0.) ((MAI1TRAV COUL ROUG) ET MAIL1 et repxyz ET OMB0 );
  20523. trac (1.E+6 0. 0.) ((MAI1TRAV COUL ROUG) ET MAIL1 et repxyz ET OMB0 );
  20524. trac (0. 0. 1.E+6) ((MAI1TRAV COUL ROUG) ET MAIL1 et repxyz ET OMB0 );
  20525. FINSI ;
  20526. *---- CAS 2D ==> TRACE DANS LE PLAN
  20527. SINON ;
  20528. SI ((nbno ptest) > 1) ;
  20529. titre 'pas='i1' on trouve'(nbno (pt1)) 'noeuds verifiant le critere';
  20530. trac (MAI1TRAV ET (PT1 COUL ROUG) ET MAIL1 ET OMB0 );
  20531. SINON ;
  20532. titre 'pas='i1' pas de noeud verifiant le critere';
  20533. trac (MAIL1 ET MAI1TRAV ET OMB0 );
  20534. FINSI ;
  20535. FINSI ;
  20536. FINSI;
  20537. FINSI;
  20538. MENAGE ;
  20539. FIN BOUCLE2 ;
  20540. * --------------------- Fin de la boucle 2 ----------------------
  20541.  
  20542. *---- PASSAGE DU SUPPORT MAILLAGE DEFORME
  20543. *---- AU SUPPORT MAILLAGE INITIAL POUR CHDIST
  20544.  
  20545. * CREATION DE LA LISTE DES DISTANCES CONTENUES DANS CHDIST
  20546. *
  20547. NDIST = NBNO MAI1TRAV ;
  20548. I = 1 ;
  20549. MAI1TRAV = CHAN MAI1TRAV POI1 ;
  20550. PT1 = ELEM MAI1TRAV POIN 1 ;
  20551. DIST1 = EXTR CHDIST SCAL PT1 ;
  20552. LDIST = PROG DIST1 ;
  20553. REPETER BOULISTE (NDIST - 1) ;
  20554. I = I + 1 ;
  20555. PTI = ELEM MAI1TRAV POIN I ;
  20556. DISTI = EXTR CHDIST SCAL PTI ;
  20557. LDIST = LDIST ET (PROG DISTI) ;
  20558. FIN BOULISTE ;
  20559.  
  20560. * CONSTRUCTION DU CHAMP DES DISTANCES SUR LE MAILLAGE NON DEFORME *
  20561. CHDIST0 = MANU CHPO MAIL1 1 SCAL LDIST ;
  20562.  
  20563. *--- Sorties dans TAB1
  20564. TAB1.<DELIM = DELIM ;
  20565. TAB1.<CONNEXION_MAX = LMAX1 ;
  20566. TAB1.<LONGUEUR_REMONTEE = LCOURAN1 ;
  20567. MESS '---------------------------------> exiting @TESTGEO';
  20568. FINPROC CHDIST0 MAI1TRAV POMB ;
  20569.  
  20570. **** @THERSC0
  20571. 'DEBPROC' @THERSC0 TAB1*'TABLE ' ;
  20572. MESS ' ' ;
  20573. NIVEAU = TAB1.'NIVEAU' ;
  20574. SI ((EXISTE TAB1 'VITESSE') OU (EXISTE TAB1 'PRESS_IN') OU (EXISTE TAB1 'TEMPE_IN'));
  20575. MESS ' ' ;
  20576. MESS ' ' ;
  20577. MESS ' ' ;
  20578. MESS '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' ;
  20579. MESS ' ' ;
  20580. MESS '>@THERSC0> RM le 26/10/95 ' ;
  20581. MESS '>@THERSC0> attention plusieurs donnees doivent etre stockees';
  20582. MESS '>@THERSC0> sous des noms d indices differents ' ;
  20583. MESS '>@THERSC0> VITESSE remplace par V_IN ' ;
  20584. MESS '>@THERSC0> TEMPE_IN remplace par T_IN ' ;
  20585. MESS '>@THERSC0> PRESS_IN remplace par P_IN ' ;
  20586. MESS ' ' ;
  20587. MESS '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' ;
  20588. MESS ' ' ;
  20589. MESS ' ' ;
  20590. MESS ' ' ;
  20591. MESS ' ' ;
  20592. FINSI;
  20593.  
  20594. SI (NIVEAU >EG 4 ) ;
  20595. MESS '---------------------------------> calling @THERSC0';
  20596. MESS '>@THERSC0> Talking Level' NIVEAU ;
  20597. FINSI ;
  20598. *
  20599. * --- procedure d'initialisation thermique standard groupe CFP
  20600. *
  20601. TAC8 = TABLE ;
  20602. TAC8.1 = 'MARQ CROI REGU' ;
  20603. TAC8.2 = 'MARQ PLUS REGU' ;
  20604. TAC8.3 = 'MARQ ETOI REGU' ;
  20605. TAC8.4 = 'MARQ LOSA REGU' ;
  20606. TAC8.5 = 'MARQ CARR REGU' ;
  20607. TAC8.6 = 'MARQ TRIA REGU' ;
  20608. TAC8.7 = 'MARQ TRIB REGU' ;
  20609. TAC8.8 = 'MARQ PLUS REGU' ;
  20610. TAC8.9 = 'MARQ ETOI REGU' ;
  20611. TAC8.10 = 'MARQ CROI REGU' ;
  20612. TAC8.11 = 'MARQ LOSA REGU' ;
  20613. TAC8.12 = 'MARQ CARR REGU' ;
  20614. TAC8.13 = 'MARQ TRIA REGU' ;
  20615. TAC8.14 = 'MARQ TRIB REGU' ;
  20616. TAC8.15 = 'MARQ ETOI REGU' ;
  20617. TAC8.16 = 'MARQ CROI REGU' ;
  20618. TAC8.17 = 'MARQ PLUS REGU' ;
  20619. TAC8.18 = 'MARQ CARR REGU' ;
  20620. TAC8.19 = 'MARQ CARR REGU' ;
  20621. TAC8.20 = 'MARQ TRIA REGU' ;
  20622. TAC8.21 = 'MARQ TRIB REGU' ;
  20623. TAC8.22 = 'MARQ CROI REGU' ;
  20624. TAC8.23 = 'MARQ PLUS REGU' ;
  20625. TAC8.24 = 'MARQ ETOI REGU' ;
  20626. TAC8.25 = 'MARQ CROI REGU' ;
  20627. TAC8.26 = 'MARQ PLUS REGU' ;
  20628. TAC8.27 = 'MARQ ETOI REGU' ;
  20629. TAC8.28 = 'MARQ CROI REGU' ;
  20630. *
  20631. SI ( EGA ( VALE DIME) 2 ) ;
  20632. TAB1.VIEW_P = TEXT ' ' ;
  20633. FINSI ;
  20634. SI ( NON (EXISTE TAB1 VIEW_P )) ;
  20635. SI ( EGA ( VALE DIME) 3 ) ;
  20636. TAB1.VIEW_P = 1.E8 -1.E8 1.E8 ;
  20637. FINSI ;
  20638. FINSI ;
  20639. *
  20640. * list V_DIM1 ;
  20641. * list TAB1.LFLUX_EXTE;
  20642. V_DIM1 = VALEUR 'DIME' ;
  20643. SI ( V_DIM1 EGA 2) ;
  20644. TFRONT1 = TEXT ' CONTOUR ' ;
  20645. TAB1 . MO_CONTOUR = TEXT ' CONTOUR ' ;
  20646. SI ( NON ( EXISTE TAB1 LFLUX_EXTE_DESS));
  20647. TAB1.LFLUX_EXTE_DESS = TAB1.LFLUX_EXTE ;
  20648. FINSI ;
  20649. SI ( NON ( EXISTE TAB1 LFLUX_CONV_DESS));
  20650. TAB1.LFLUX_CONV_DESS = TAB1.LFLUX_CONV ;
  20651. FINSI ;
  20652. SI ( NON ( EXISTE TAB1 LFLUX_RAYO_DESS));
  20653. TAB1.LFLUX_RAYO_DESS = TAB1.LFLUX_RAYO ;
  20654. FINSI ;
  20655. SINON ;
  20656. TFRONT1 = TEXT ' ENVELOP ' ;
  20657. TAB1 . MO_CONTOUR = TEXT ' ENVELOP ' ;
  20658. FINSI ;
  20659.  
  20660. SI ( NON ( EXISTE TAB1 TITR_MAQ )) ;
  20661. TAB1.TITR_MAQ = ' ' ;
  20662. SI (NIVEAU >EG 2) ;
  20663. MESS '>@THERSC0> TAB1.TITR_MAQ set to default value : nothing ' ;
  20664. FINSI ;
  20665. FINSI ;
  20666.  
  20667. SI ( NON ( EXISTE TAB1 T_TAPE )) ;
  20668. TAB1.T_TAPE = 0. ;
  20669. SI (NIVEAU >EG 2) ;
  20670. MESS '>@THERSC0> TAB1.T_TAPE set to default value : 0 ' ;
  20671. FINSI ;
  20672. FINSI ;
  20673.  
  20674. SI ( NON ( EXISTE TAB1 TWIST_RATIO )) ;
  20675. TAB1.TWIST_RATIO = 0. ;
  20676. SI (NIVEAU >EG 2) ;
  20677. MESS '>@THERSC0> TAB1.TWIST_RATIO set to default value : 0';
  20678. FINSI ;
  20679. FINSI ;
  20680.  
  20681. SI ( NON ( EXISTE TAB1 L_TRAC_FLUXI )) ;
  20682. TAB1.L_TRAC_FLUXI = FAUX ;
  20683. SI (NIVEAU >EG 2) ;
  20684. MESS '>@THERSC0> TAB1.L_TRAC_FLUXI set to default value : FAUX' ;
  20685. FINSI ;
  20686. FINSI ;
  20687.  
  20688. SI (NON (EXISTE TAB1 CHFCORRELATION));
  20689. TAB1.CHFCORRELATION = MOTS 'TONG';
  20690. SI (NIVEAU >EG 2) ;
  20691. MESS '>@THERSC0> TAB1.CHFCORRELATION set to default value : TONG' ;
  20692. FINSI ;
  20693. FINSI ;
  20694.  
  20695. SI (NON (EXISTE TAB1 X_LOCAL));
  20696. TAB1.'X_LOCAL' = 1. ;
  20697. SI (NIVEAU >EG 2) ;
  20698. MESS '>@THERSC0> TAB1.X_LOCAL set to default value : 1.(=exit)' ;
  20699. FINSI ;
  20700. FINSI ;
  20701.  
  20702.  
  20703. *
  20704. *--- CARACT . DE L'ECOULEMENT
  20705. *
  20706. PI = 3.14159 ;
  20707. *
  20708. VIN = TAB1 . V_IN ;
  20709. TAB1.V_LOCAL = VIN ;
  20710. MESS '>@THERSC0> V_LOCAL set to VIN (provisional) ';
  20711. TIN = TAB1 . T_IN ;
  20712. LMAQ = TAB1 . L_MAQUETTE ;
  20713. DIAM1 = TAB1 . D_MAQUETTE ;
  20714. PIN = TAB1 . P_IN ;
  20715. TTAPE = TAB1 . T_TAPE ;
  20716. YTWIST = TAB1 . TWIST_RATIO ;
  20717. LAMBDA = TAB1 . 'LAMBDA' ;
  20718. LPAT1 = TAB1 . LFLUX_EXTE ;
  20719. *
  20720. *--- CALCUL CHUTE DE PRESSION
  20721. *
  20722. *js tous ces XLPAT1 XL_LPAT1 TAB1 . W_HEATED n'ont rien a faire ici
  20723. *js c est le pb CFLUX
  20724. XLPAT1 = COOR 1 LPAT1 ;
  20725. XL_LPAT1 = ABS (( MAXI XLPAT1 ) - ( MINI XLPAT1 ));
  20726.  
  20727. MESS '>@THERSC0> width of the mesh line used for flux deposition' XL_LPAT1 ;
  20728.  
  20729. SI ( NON ( EXISTE TAB1 W_HEATED )) ;
  20730. TAB1 . W_HEATED = XL_LPAT1 * (TAB1 . FSYM_X ) ;
  20731. MESS '>@THERSC0> Heated width (with symetrical part)' (TAB1.W_HEATED);
  20732. SINON ;
  20733. XL_HEATE = ((TAB1 . W_HEATED ) / (TAB1 . FSYM_X )) ;
  20734. MESS '>@THERSC0> control of the heated width ' ;
  20735. MESS '>@THERSC0> heated width / FSYM_X ' XL_HEATE ;
  20736. FINSI ;
  20737.  
  20738. SI (NIVEAU >EG 3 ) ;
  20739. MESS '>@THERSC0> prompting of various data before PDROP';
  20740. MESS DIAM1 VIN TIN LMAQ (TAB1.L_HEATED) (TAB1.W_HEATED) LAMBDA PIN TTAPE YTWIST ;
  20741. FINSI ;
  20742.  
  20743. SI ( NON ( EXISTE TAB1 HYPERVAP ) ) ;
  20744. TAB1.HYPERVAP = FAUX ;
  20745. FINSI ;
  20746. *js TAB1.P_LOCAL doit etre calculer par @PDROP
  20747. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  20748. TAB1 . P_LOCAL = PIN ;
  20749. SINON ;
  20750. SI (NON (EXISTE TAB1 P_LOCAL)) ;
  20751. DPRES PIN_LH POU_H POUT = @PDROP TAB1 ;
  20752. TAB1.P_LOCAL = PIN_LH + ((POU_H - PIN_LH) * TAB1.'X_LOCAL') ;
  20753. FINSI ;
  20754. FINSI ;
  20755. *
  20756. *
  20757. *js CPF = @IPOE TIN TAB1.ETCPF ;
  20758. *js
  20759. *js RHOIN = @IPOE TIN TAB1.ETRHOF ;
  20760. *
  20761. *js NNUIN = @IPOE TIN TAB1.ETNNU ;
  20762. *js GIN = RHOIN * VIN ;
  20763. *js SI ( EXISTE TAB1 RIP_FLOWS ) ;
  20764. *js EMDOTI = GIN * ( TAB1 . RIP_FLOWS ) ;
  20765. *js SINON ;
  20766. *js SI ( EGA TAB1.HYPERVAP VRAI ) ;
  20767. *js TAB1.HYP_SM = ( TAB1.LARG_CANAL * TAB1.HMIN_CANAL ) +
  20768. *js ( 2. * ( TAB1.LARG_ESP * TAB1.HFIN ) ) ;
  20769. *js EMDOTI = GIN * TAB1.HYP_SM ;
  20770. *js SINON ;
  20771. *js EMDOTI = GIN * ( ( PI * DIAM1 * DIAM1 / 4. ) - ( DIAM1 * TTAPE) ) ;
  20772. *js FINSI ;
  20773. *js FINSI ;
  20774. * Parametre servant au calcul de Tout grace au flux,
  20775. * au Cp et a Tin
  20776. *js TAB1.V_EMDOTI = EMDOTI ;
  20777.  
  20778. *
  20779. *--- DONNEES POUR 'H' DANS LA BOUCLE
  20780. *
  20781. SI (NIVEAU >EG 2 ) ;
  20782. MESS '>@THERSC0> >>>>> 1 >>>>>>' ;
  20783. FINSI ;
  20784. SI ( NON ( EXISTE TAB1 TRANSITOIRE )) ;
  20785. TAB1.TRANSITOIRE = FAUX ;
  20786. FINSI ;
  20787. SI ( NON ( EXISTE TAB1 PERMANENT )) ;
  20788. TAB1.PERMANENT = FAUX ;
  20789. FINSI ;
  20790. SI ( NON ( EXISTE TAB1 MAX_SOFL )) ;
  20791. TAB1.MAX_SOFL = 50.E6 ;
  20792. FINSI ;
  20793. SI ( NON ( EXISTE TAB1 OLD )) ;
  20794. TAB1.OLD = VRAI ;
  20795. FINSI ;
  20796. SI TAB1.OLD ;
  20797. EVMA1 EVCA1 TACC1 = @DEMATH1 TAB1 ;
  20798. SINON ;
  20799. EVMA1 EVCA1 TACC1 = @DEMATH2 TAB1 ;
  20800. FINSI ;
  20801. *js3.95 ici il faudrait faire une proc de controle du maillage @CTMAIL
  20802. SI (NIVEAU >EG 2 ) ;
  20803. MESS '>@THERSC0> >>>>> 2.1>>>>>>> ' ;
  20804. FINSI ;
  20805.  
  20806. IPP1 = 0 ;
  20807. REPETER BOUCMA8 ;
  20808. IPP1 = IPP1 + 1 ;
  20809. SI ( EXISTE (TAB1.ZONE_MAT) IPP1 ) ;
  20810. SI ( IPP1 EGA 1 ) ;
  20811. S_TOT1 = TAB1.ZONE_MAT . IPP1 ;
  20812. C_ONT1 = TFRONT1 (TAB1.ZONE_MAT . IPP1 ) ;
  20813. SINON ;
  20814. S_TOT1 = S_TOT1 ET (TAB1.ZONE_MAT . IPP1) ;
  20815. C_ONT1 = C_ONT1 ET ( TFRONT1 (TAB1.ZONE_MAT. IPP1)) ;
  20816. FINSI ;
  20817. SINON ;
  20818. QUITTER BOUCMA8 ;
  20819. FINSI ;
  20820. FIN BOUCMA8 ;
  20821. TAB1.'M_ILLAGE_TOT' = S_TOT1 ;
  20822. TAB1.'<MAILLAGE' = S_TOT1 ;
  20823.  
  20824. TRAC TAB1.VIEW_P S_TOT1 ;
  20825. TAB1.'M_IL_CONTOUR' = C_ONT1 ;
  20826. IPP1 = 0 ;
  20827.  
  20828. SI ( EXISTE TAB1 V_SOURCE ) ;
  20829. MESS '>@THERSC0> There is a volumetric heat source';
  20830. MO_TOT = MODE S_TOT1 'THERMIQUE' 'ISOTROPE' ;
  20831. FSOU1 = SOURCE MO_TOT 0. S_TOT1 ;
  20832. FINSI ;
  20833. REPETER BOUCMA9 ;
  20834. IPP1 = IPP1 + 1 ;
  20835. SI ( EXISTE (TAB1.ZONE_MAT) IPP1 ) ;
  20836. SI ( EXISTE TAB1 V_SOURCE ) ;
  20837. *jfs,le 18/07/95: ajout de la possibilite d'utiliser des sources
  20838. * variables dans les materiaux (chpoints)
  20839. SI ( EXISTE (TAB1.V_SOURCE) CHSO ) ;
  20840. SI ( EXISTE (TAB1.V_SOURCE.CHSO) IPP1 ) ;
  20841. MO_1 = TAB1.DEF_MO.IPP1 ;
  20842. FSOU1 = FSOU1 ET ( SOURCE MO_1 TAB1.V_SOURCE.CHSO.IPP1 ) ;
  20843. MESS '>THERSCH0> SOURCE MATERIAL CHPOINT ' IPP1 ;
  20844. FINSI ;
  20845. SINON ;
  20846. SI ( EXISTE (TAB1.V_SOURCE) IPP1 ) ;
  20847. * MO_1 = MODE TAB1.ZONE_MAT.IPP1 'THERMIQUE' 'ISOTROPE' ;
  20848. MO_1 = TAB1.DEF_MO.IPP1 ;
  20849. FSOU1 = FSOU1 ET ( SOURCE MO_1 TAB1.V_SOURCE.IPP1 TAB1.ZONE_MAT.IPP1 ) ;
  20850. MESS '>@THERSC0> SOURCE MATERIAL ' IPP1 ;
  20851. FINSI ;
  20852. FINSI ;
  20853. FINSI ;
  20854. SINON ;
  20855. QUITTER BOUCMA9 ;
  20856. FINSI ;
  20857. FIN BOUCMA9 ;
  20858. TAB1.'FSOU1' = FSOU1 ;
  20859. *
  20860. SI (NIVEAU >EG 2 ) ;
  20861. MESS '>@THERSC0> >>>>> 2.2 >>>>>>' ;
  20862. FINSI ;
  20863. TRAC TAB1.VIEW_P CACH TAB1.'M_IL_CONTOUR' ;
  20864. SI ( EXISTE TAB1 VIEW_P2 ) ;
  20865. TRAC CACH TAB1.VIEW_P2 C_ONT1 ;
  20866. FINSI ;
  20867. * TEX1 = TEXTE TAB1.NOM_MAT.1 '_MAT_1_CONDUCTIVITY' ;
  20868. SI ( NON ( EXISTE TAB1 V_XBORMA));
  20869. TAB1.V_XBORMA = 1500. ;
  20870. FINSI ;
  20871. TAC1 = TABLE ;
  20872. * TAC1.1 = TEXTE 'MARQ TRIA TITRE ' TEX1 ;
  20873. DESSIN EVMA1 XBOR 0. TAB1.V_XBORMA YBOR 0. 500. MIMA LEGE TACC1;
  20874. SI ( TAB1.TRANSITOIRE ) ;
  20875. TAC1 = TABLE ;
  20876. SI (EXISTE (TAB1.ZONE_MAT) 1);
  20877. TAC1.1 = ET 'MARQ TRIA REGU TITRE ' TAB1.NOM_MAT.1;
  20878. FINSI;
  20879. SI (EXISTE (TAB1.ZONE_MAT) 2);
  20880. TAC1.2 = ET 'MARQ TRIB TITRE ' TAB1.NOM_MAT.2;
  20881. FINSI;
  20882. SI (EXISTE (TAB1.ZONE_MAT) 3);
  20883. TAC1.3 = ET 'MARQ ETOI TITRE 'TAB1.NOM_MAT.3;
  20884. FINSI;
  20885. SI (EXISTE (TAB1.ZONE_MAT) 4);
  20886. TAC1.4 = ET 'MARQ LOSA TITRE 'TAB1.NOM_MAT.4;
  20887. FINSI;
  20888. DESSIN EVCA1 XBOR 0. TAB1.V_XBORMA MIMA LEGE TAC1 ;
  20889. FINSI ;
  20890. *js3.95 ici proc pour calcul des cos directeurs
  20891. *** modele necessaire pour le calcul des cosinus directeurs
  20892. *
  20893. MOP_TOT = MODE S_TOT1 'MECANIQUE' 'ELASTIQUE' ;
  20894. *
  20895. *
  20896. *--- PERPENDICULAIRE A LA LIGNE DE RAYONNEMENT
  20897. *
  20898. SI ( NON ( EXISTE TAB1 LFLUX_RAYO_DESS));
  20899. TAB1.LFLUX_RAYO_DESS = TAB1.LFLUX_RAYO ;
  20900. FINSI ;
  20901. *> SI ( NON ( EXISTE TAB1 LFLUX_RAY2 )) ;
  20902. *> TAB1.LFLUX_RAY2 = TAB1.LFLUX_RAYO ;
  20903. *> TAB1.LFLUX_RAY2_DESS = TAB1.LFLUX_RAYO_DESS ;
  20904. *> FINSI ;
  20905. ** LRAYON1 = TAB1.LFLUX_RAYO ;
  20906.  
  20907. COTETR1 SITETR1 C3TETR1 = @VNORM3D (EXTR TAB1.'MODELR' 'MAIL' ) TAB1.LFLUX_RAYO NIVEAU;
  20908. *
  20909. *--- PERPENDICULAIRE A LA LIGNE DE CONVECTION
  20910. *
  20911. * LINT1 = TAB1.LFLUX_CONV ;
  20912. S_CONV = EXTR TAB1.'MODELV' 'MAIL' ;
  20913. C_CONV = TAB1.MO_CONTOUR S_CONV ;
  20914. N_E1 = NBNO C_CONV ;
  20915. N_E2 = NBNO (C_CONV ET TAB1.LFLUX_CONV) ;
  20916. SI ( N_E1 NEG N_E2 ) ;
  20917. ERRE '@THERSC0 >>>NBNO DIFFERENTS POUR LFLUX_CONV et MODELV ' ;
  20918. FINSI ;
  20919. *SI (EXISTE TAB1 STUB1 ) ;
  20920. * COTETC1 SITETC1 C3TETC1 = @VNORM3D
  20921. * TAB1.STUB1 TAB1.LFLUX_CONV NIVEAU;
  20922. *SINON ;
  20923. COTETC1 SITETC1 C3TETC1 = @VNORM3D S_CONV (TAB1.LFLUX_CONV) NIVEAU;
  20924. *FINSI ;
  20925. MESS '@THERSC0 >>>>> 2.3 >>>>>>' ;
  20926. *
  20927. *--- PERPENDICULAIRE A LA LIGNE DE FLUX INCIDENT
  20928. *
  20929. SI ( EXISTE TAB1 'LAMDAQ2' ) ;
  20930. COTETF1 SITETF1 C3TETF1 = @VNORM3D ( EXTR TAB1.'MODELF' 'MAIL') (TAB1.LFLUX_EXTE ET TAB1.LFLUX_EXT2) NIVEAU;
  20931. SINON;
  20932. COTETF1 SITETF1 C3TETF1 = @VNORM3D (EXTR TAB1.'MODELF' 'MAIL') ( TAB1.LFLUX_EXTE) NIVEAU;
  20933. FINSI ;
  20934. TAB1.C_COTETF1 = COTETF1 ;
  20935. TAB1.C_SITETF1 = SITETF1 ;
  20936. *---- A.MOAL : on a besoin du 3eme cos directeur pour la visu 3D
  20937. TAB1.C_COS3F1 = C3TETF1 ;
  20938. TAB1.C_C3TETF1 = C3TETF1 ;
  20939. *----
  20940. TAB1.C_COTETR1 = COTETR1 ;
  20941. TAB1.C_SITETR1 = SITETR1 ;
  20942. TAB1.C_C3TETR1 = C3TETR1 ;
  20943. TAB1.C_COTETC1 = COTETC1 ;
  20944. TAB1.C_SITETC1 = SITETC1 ;
  20945. TAB1.C_C3TETC1 = C3TETC1 ;
  20946.  
  20947.  
  20948. **>> TETF1 = ATG SITETF1 ( COTETF1 + 1.E-12) ;
  20949. *mess 'cotetft et sitetf1 ' ; list COTETF1 ; list SITETF1;
  20950.  
  20951. *js 3 11 94
  20952. *TAB1.LIS_TEMP = TABLE ;
  20953. * IPP1 = 0;
  20954. * REPETER BOUPO2 (DIME TAB1.LI_POINT);
  20955. * IPP1 = IPP1 + 1;
  20956. * TAB1.LIS_TEMP . IPP1 = PROG;
  20957. * FIN BOUPO2;
  20958. *
  20959. * ca ce devrait etre ds le controle du maillage
  20960. NB_1 = NBNO TAB1.'M_IL_CONTOUR' ;
  20961. NB_2 = NBNO ( TAB1.LFLUX_EXTE ET TAB1.'M_IL_CONTOUR' ) ;
  20962. SI ( NB_1 NEG NB_2 ) ;
  20963. MESS ' IL Y A UN PB ENTRE LA LIGNE DE FLUXI ET LE CONTOUR' ;
  20964. TRACER 'CACH' TAB1.VIEW_P ( TAB1.LFLUX_EXTE ET C_ONT1 ) ;
  20965. ERRE ' REVOIR VOTRE LFLUX_EXTE ' ;
  20966. FINSI ;
  20967. *
  20968. TAB1.CHPOTHETA = TABLE ;
  20969. TAB1.CHPOHCONV = TABLE ;
  20970. SI (NIVEAU >EG 2 ) ;
  20971. MESS '---------------------------------> exiting @THERSC0';
  20972. FINSI ;
  20973.  
  20974. FINPROC ;
  20975.  
  20976. *--------------------------------------------------------------------
  20977. *
  20978. *----------Fin de la procedure @THERSC0
  20979. **** @THERSC1
  20980. 'DEBPROC' @THERSC1 TAB1*'TABLE ' ;
  20981.  
  20982. SI (NON (EXISTE TAB1 NIVEAU));
  20983. TAB1.'NIVEAU' = 1 ;
  20984. FINSI ;
  20985. SI (TAB1.'NIVEAU' >EG 4) ;
  20986. MESS '---------------------------------> calling @THERSC1';
  20987. FINSI ;
  20988.  
  20989. *
  20990. *--- PARAMETRES
  20991. *
  20992. @TABEAU TAB1 ;
  20993. @THERSC0 TAB1 ;
  20994. @FLUXX TAB1 ;
  20995. MENAGE ;
  20996. @TPERM TAB1 ;
  20997. @TTRANS TAB1 ;
  20998. *TAB1.I_FPAT1 = FPAT1;
  20999. TAB1.T_TAC8 = TABLE TAC8;
  21000. SI (TAB1.PERMANENT EGA VRAI);
  21001. FINSI;
  21002.  
  21003. SI (TAB1.'NIVEAU' >EG 4 );
  21004. MESS '---------------------------------> exiting @THERSC1';
  21005. FINSI ;
  21006.  
  21007. FINPROC;
  21008. *--------------------------------------------------------------------
  21009. *
  21010. *----------Fin de la procedure @THERSC1
  21011. *
  21012. **** @TOKAFLU
  21013. DEBPROC @TOKAFLU TAB1*TABLE ;
  21014. *
  21015. *123456789012345678901234567890123456789012345678901234567890123456789012
  21016. **************************************************************
  21017. * Procedure de calcul du profil du depot de puissance sur un *
  21018. * objet en tenant compte du ripple et du shift de Shafranov. *
  21019. * Alain MOAL (aout 1995-janvier 1996) *
  21020. **************************************************************
  21021. *
  21022. MESS '---------------------------------> calling @TOKAFLU';
  21023. *
  21024. *---- Valeurs par defaut, verification des indices de la table
  21025. @VDEFAUT TAB1 ;
  21026. *
  21027. *--------------- VARIABLES D'ENTREE :
  21028. MAIL0 = TAB1.<MAILLAGE ;
  21029. CONT0 = TAB1.LFLUX_EXTE ;
  21030. LAMBQREF = TAB1.<LAMBQREF ;
  21031. THETA0 = TAB1.<THETA0 ;
  21032. RHO0 = TAB1.<RHO0 ;
  21033. RP = TAB1.<RP ;
  21034. IMESS = TAB1.<IMESS ;
  21035. MMAIL0 = TAB1.MODELF ;
  21036. TYPCAL = TAB1.<TYPE_CALCUL ;
  21037. TYPDEP = MOT TAB1.<TYPE_DEPOT ;
  21038. ITRAC = TAB1.<ITRAC ;
  21039. SI (NON (EXISTE TAB1 <NXM)) ;
  21040. ICALNORM = VRAI ;
  21041. SINON ;
  21042. ICALNORM = FAUX ;
  21043. NXM = TAB1.<NXM ;
  21044. NYM = TAB1.<NYM ;
  21045. NZM = TAB1.<NZM ;
  21046. FINSI ;
  21047. SI ((VALEUR DIME) EGA 3) ;
  21048. OEIL0 = TAB1.VIEW_P ;
  21049. SINON ;
  21050. CONTDES0 = TAB1.LFLUX_EXTE_DESS ;
  21051. FINSI ;
  21052. *------------------------------------
  21053. *
  21054. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  21055. ISHIFT = VRAI ;
  21056. IRIPPLE = VRAI ;
  21057. FINSI ;
  21058. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  21059. ISHIFT = VRAI ;
  21060. IRIPPLE = FAUX ;
  21061. FINSI ;
  21062. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  21063. ISHIFT = FAUX ;
  21064. IRIPPLE = VRAI ;
  21065. FINSI ;
  21066. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  21067. ISHIFT = FAUX ;
  21068. IRIPPLE = FAUX ;
  21069. FINSI ;
  21070. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  21071. ERRE ' >>>> @TOKAFLU : check the value of TAB1.<TYPE_CALCUL';
  21072. FINSI ;
  21073. SI (EGA TYPDEP 'PARALLELE');
  21074. ITYPDEP = VRAI ;
  21075. SINON ;
  21076. ITYPDEP = FAUX ;
  21077. FINSI ;
  21078. *
  21079. *---- coordonnees dans le repere du maillage
  21080. XM = COOR 1 CONT0 ;
  21081. YM = COOR 2 CONT0 ;
  21082. SI ((VALEUR DIME) EGA 2) ;
  21083. ZM = XM * 0. ;
  21084. SINON ;
  21085. ZM = COOR 3 CONT0 ;
  21086. FINSI ;
  21087. *
  21088. *---- coordonnees dans le repere global
  21089. XG YG ZG = @CRMGC XM YM ZM TAB1 ;
  21090. MENAGE ;
  21091. *
  21092. *---- calcul du champ magnetique dans le repere global
  21093. BXG BYG BZG FSECU = @CHAMB TAB1 XG YG ZG ISHIFT IRIPPLE ;
  21094. MENAGE ;
  21095. *
  21096. *---- composantes de B dans le repere du maillage
  21097. BXM BYM BZM = @CBGMV BXG BYG BZG TAB1 ;
  21098. MENAGE ;
  21099. *
  21100. *---- calcul des normales a la surface calculees
  21101. *---- dans le repere du maillage
  21102. SI (ICALNORM) ;
  21103. NXM NYM NZM = @VNORM3D MAIL0 CONT0 ;
  21104. TAB1.<NXM = NXM ;
  21105. TAB1.<NYM = NYM ;
  21106. TAB1.<NZM = NZM ;
  21107. FINSI;
  21108. MENAGE ;
  21109. *
  21110. *---- calcul du produit scalaire et de l'angle d'incidence
  21111. B_NORM = ((BXM*BXM) + (BYM*BYM) + (BZM*BZM))**0.5 ;
  21112. VBVN = (ABS ((BXM*NXM) + (BYM*NYM) + (BZM*NZM))) / B_NORM;
  21113. ANGINCI = ATG ((1.-(VBVN**2))**0.5) VBVN ;
  21114. *
  21115. *---- dans le plan xy du repere du maillage
  21116. BETA2DXY = ATG (BYM*-1.) (BXM*-1.) ;
  21117. *---- dans le plan xz du repere du maillage
  21118. BETA2DXZ = ATG (BZM*-1.) (BXM*-1.) ;
  21119. *
  21120. *---- calcul de Lambdaq et des facteurs de compression
  21121. LAMBQ HS HR DELTA = @CLAMQ TAB1 XG YG ZG ISHIFT IRIPPLE ;
  21122. MENAGE ;
  21123. *
  21124. *---- calcul de la densite de puissance recue par chaque point
  21125. VAR1 = EXP (DELTA * -1. / LAMBQ) ;
  21126. *
  21127. *---- profil du flux modif RM le 08/12/1998
  21128. SI ITYPDEP ;
  21129. PROFIL0 = VAR1 * VBVN ;
  21130. SINON ;
  21131. PROFIL0 = VAR1 * ((1. - (VBVN*VBVN)) ** .5) ;
  21132. FINSI ;
  21133. *
  21134. *---- integration du profil de flux sur la surface
  21135. PROCONT0 = NOMC SCAL (FLUX MMAIL0 PROFIL0) ;
  21136. *
  21137. *---- calcul du profil moyen
  21138. PROMOY = (MAXI (RESU PROCONT0)) / (MESU CONT0) ;
  21139. *
  21140. SI (IMESS >EG 2) ;
  21141. MESS '>>>> @TOKAFLU : BXM '; MESS (MAXI BXM) (MINI BXM) ;
  21142. MESS '>>>> @TOKAFLU : BYM '; MESS (MAXI BYM) (MINI BYM) ;
  21143. MESS '>>>> @TOKAFLU : BZM '; MESS (MAXI BZM) (MINI BZM) ;
  21144. MESS '>>>> @TOKAFLU : PROFIL0 ';
  21145. MESS (MAXI PROFIL0) (MINI PROFIL0) ;
  21146. MESS '>>>> @TOKAFLU : VAR1 '; MESS (MAXI VAR1) (MINI VAR1) ;
  21147. MESS '>>>> @TOKAFLU : ANGINCI ';
  21148. MESS (MAXI ANGINCI) (MINI ANGINCI) ;
  21149. FINSI ;
  21150. SI (IMESS >EG 3) ;
  21151. MESS '>>>> @TOKAFLU : BXM '; LIST BXM ;
  21152. MESS '>>>> @TOKAFLU : BYM '; LIST BYM ;
  21153. MESS '>>>> @TOKAFLU : BZM '; LIST BZM ;
  21154. MESS '>>>> @TOKAFLU : VBVN '; LIST VBVN ;
  21155. MESS '>>>> @TOKAFLU : BETA2DXY '; LIST BETA2DXY ;
  21156. MESS '>>>> @TOKAFLU : BETA2DXZ '; LIST BETA2DXZ ;
  21157. MESS '>>>> @TOKAFLU : ANGINCI '; LIST ANGINCI ;
  21158. MESS '>>>> @TOKAFLU : PROFIL0 '; LIST PROFIL0 ;
  21159. FINSI ;
  21160. *
  21161. *---- visualisations des resultats en 2D et en 3D
  21162. *
  21163. MENAGE ;
  21164. *---- vecteur champ magnetique et vecteur normal dans le repere
  21165. *---- du maillage en vue de la visualisation
  21166. VB1 = @CVECT BXM BYM BZM CONT0 VERT;
  21167. VN1 = @CVECT NXM NYM NZM CONT0 BLEU;
  21168. *
  21169. *---- profil de flux visualise dans la direction de la normale rentrante
  21170. DNORMX = PROFIL0 * NXM * -1. ;
  21171. DNORMY = PROFIL0 * NYM * -1. ;
  21172. DNORMZ = PROFIL0 * NZM * -1. ;
  21173. VECT1 = @CVECT DNORMX DNORMY DNORMZ CONT0 JAUN ;
  21174. *
  21175. *---- profil de flux integre visualise dans la direction de la normale
  21176. rentrante FNORMX = PROCONT0 * NXM * -1. ;
  21177. FNORMY = PROCONT0 * NYM * -1. ;
  21178. FNORMZ = PROCONT0 * NZM * -1. ;
  21179. VECT2 = @CVECT FNORMX FNORMY FNORMZ CONT0 JAUN ;
  21180. *
  21181. *---- traces en 2D
  21182. SI (((VALEUR DIME) EGA 2) ET ITRAC) ;
  21183. CONT0 = CONT0 COUL ROUG ;
  21184. TITRE '@TOKAFLU : NORMAL AND MAGNETIC VECTOR' ;
  21185. TRACE (VN1 ET VB1) CONT0 ;
  21186. * TRACE VB1 CONT0 ;
  21187. *
  21188. * ---- trace de courbes
  21189. TITRE '@TOKAFLU : DISTANCE TO THE LCFS (m)';
  21190. DELTA1 = NOMC SCAL DELTA ;
  21191. TAB1.1 = 'TIRR';
  21192. DESSIN (EVOL JAUN CHPO DELTA1 SCAL CONTDES0) MIMA TAB1 ;
  21193. *
  21194. TITRE '@TOKAFLU : SAFETY FACTOR Q = (a.Btor/R.Bpol)';
  21195. FSECU1 = NOMC SCAL FSECU ;
  21196. DESSIN (EVOL JAUN CHPO FSECU1 SCAL CONTDES0) MIMA ;
  21197. *
  21198. TITRE '@TOKAFLU : COSINUS OF THE ANGLE BETWEEN b AND n' ;
  21199. VBVN1 = NOMC SCAL VBVN ;
  21200. DESSIN (EVOL JAUN CHPO VBVN1 SCAL CONTDES0) MIMA ;
  21201. *
  21202. TITRE '@TOKAFLU : angle = arctg (Bz/Bx)' ;
  21203. ANGLE0 = ATG (ABS BZG) (ABS BXG) ;
  21204. ANGLE1 = NOMC SCAL ANGLE0 ;
  21205. DESSIN (EVOL JAUN CHPO ANGLE1 SCAL CONTDES0) MIMA ;
  21206. *
  21207. * TITRE 'BETA2D : ANGLE BETWEEN B AND X AXIS (assuming Bz = 0)';
  21208. * BETA2D1 = NOMC SCAL BETA2DXY ;
  21209. * DESSIN (EVOL JAUN CHPO BETA2D1 SCAL CONTDES0) MIMA ;
  21210. * TITRE 'BETA2D : ANGLE BETWEEN B AND X AXIS (assuming By = 0)';
  21211. * BETA2D2 = NOMC SCAL BETA2DXZ ;
  21212. * DESSIN (EVOL JAUN CHPO BETA2D2 SCAL CONTDES0) MIMA ;
  21213. *
  21214. TITRE '@TOKAFLU : COMPRESSION FACTORS HS (shift) AND HR (ripple)';
  21215. TAB1.1 = 'TIRR';
  21216. HS1 = NOMC SCAL HS ;
  21217. HR1 = NOMC SCAL HR ;
  21218. DESSIN ((EVOL ROUG CHPO HR1 SCAL CONTDES0) ET (EVOL JAUN CHPO HS1 SCAL CONTDES0)) MIMA TAB1;
  21219. *
  21220. TITRE '@TOKAFLU : LAMBDAQ (m)' ;
  21221. LAMBQ1 = NOMC SCAL LAMBQ ;
  21222. DESSIN (EVOL JAUN CHPO LAMBQ1 SCAL CONTDES0) MIMA;
  21223. *
  21224. TITRE '@TOKAFLU : EXP (-DELTA / LAMDAQ) ';
  21225. VAR11 = NOMC SCAL VAR1 ;
  21226. *AM DESSIN (EVOL JAUN CHPO VAR11 SCAL CONTDES0) MIMA ;
  21227. *
  21228. TITRE '@TOKAFLU : PROFILE OF THE INCIDENT FLUX' ;
  21229. PROFIL1 = NOMC SCAL PROFIL0 ;
  21230. DESSIN (EVOL JAUN CHPO PROFIL1 SCAL CONTDES0) MIMA ;
  21231. *
  21232. TITRE '@TOKAFLU : PROFILE OF THE INCIDENT FLUX' ;
  21233. TRACE VECT1 CONT0 ;
  21234. TITRE '@TOKAFLU : PROFILE OF THE INTEGRATED INCIDENT FLUX' ;
  21235. TRACE VECT2 CONT0 ;
  21236. FINSI ;
  21237. *
  21238. *---- traces en 3D
  21239. SI (((VALEUR DIME) EGA 3) ET ITRAC) ;
  21240. *
  21241. SI (EGA (VALEUR ELEM) 'CUB8') ;
  21242. ARET1 = ARETE CONT0 ;
  21243. SINON ;
  21244. ARET1 = ARETE CONT0 40. ;
  21245. FINSI ;
  21246. TITRE '@TOKAFLU : MAGNETIC FIELD AND NORMAL VECTOR' ;
  21247. TRACE CACH OEIL0 (VB1 ET VN1) MAIL0 ;
  21248. TITRE '@TOKAFLU : COSINUS OF THE ANGLE BETWEEN b AND n' ;
  21249. TRACE CACH OEIL0 7 VBVN CONT0 ARET1;
  21250. * RM 11/06/1997 je commente les deux lignes suivantes,
  21251. * car je prefere lui faire tracer 90. - angleinci
  21252. * TITRE '@TOKAFLU : ANGLE BETWEEN VECTORS b AND n (DEGREE)' ;
  21253. * TRACE CACH OEIL0 7 ANGINCI CONT0 ARET1;
  21254. TITRE '@TOKAFLU : ANGLE BETWEEN VECTORS B AND SURFACE (DEGREE)' ;
  21255. TRACE CACH OEIL0 7 (90. - ANGINCI) CONT0 ARET1;
  21256. * TITRE '@TOKAFLU : BETA2DXZ' ;
  21257. * TRACE CACH OEIL0 7 BETA2DXZ CONT0 ARET1;
  21258. * TITRE '@TOKAFLU : BETA2DXY' ;
  21259. * TRACE CACH OEIL0 7 BETA2DXY CONT0 ARET1 ;
  21260. TITRE '@TOKAFLU : NORM OF THE MAGNETIC FIELD (TESLA)' ;
  21261. TRACE CACH OEIL0 7 B_NORM CONT0 ARET1 ;
  21262. TITRE '@TOKAFLU : SAFETY FACTOR Q = (a.Btor/R.Bpol)' ;
  21263. TRACE CACH OEIL0 7 FSECU CONT0 ARET1 ;
  21264.  
  21265. SI (NON (EGA (MAXI LAMBQ) (MINI LAMBQ))) ;
  21266. TITRE '@TOKAFLU : ISOVALUES OF LAMBDAQ (M)' ;
  21267. TRACE CACH OEIL0 7 LAMBQ CONT0 ARET1;
  21268. SINON ;
  21269. MESS '>>> @TOKAFLU >>> Lambdaq constant egal a ' (MAXI LAMBQ) ;
  21270. FINSI ;
  21271.  
  21272. TITRE '@TOKAFLU : DISTANCE TO THE LCFS (M)' ;
  21273. TRACE CACH OEIL0 7 DELTA CONT0 ARET1;
  21274.  
  21275. distmin1 = mini DELTA ;
  21276. mess '>@TOKAFLU> MINIMAL DISTANCE BETWEEN LIMITER AND DSMF' distmin1 ;
  21277.  
  21278. TITRE '@TOKAFLU : exp (- delta / lamdaq)' ;
  21279. TRACE CACH OEIL0 7 VAR1 CONT0 ARET1;
  21280. TITRE '@TOKAFLU : PROFILE OF THE INCIDENT HEAT FLUX' ;
  21281. * TRACE OEIL0 VECT1 CONT0 ;
  21282. TRACE CACH OEIL0 7 PROFIL0 CONT0 ARET1 ;
  21283. * TITRE '@TOKAFLU : PROFILE OF THE INTEGRATED INCIDENT FLUX';
  21284. * TRACE OEIL0 VECT2 CONT0 ;
  21285. FINSI ;
  21286. *
  21287. *--------------- VARIABLES DE SORTIE :
  21288. TAB1.V_FACFM2 = PROMOY ;
  21289. TAB1.<ANGINCI = ANGINCI ;
  21290. TAB1.<VBVN = VBVN ;
  21291. TAB1.<LONG_DECROIS = LAMBQ ;
  21292. TAB1.<DIST_DSMF = DELTA ;
  21293. TAB1.<FSECU = FSECU ;
  21294. *-------------------------------------
  21295. MESS '---------------------------------> exiting @TOKAFLU';
  21296. FINPROC PROFIL0 ;
  21297. **** @TOKAPEN
  21298. DEBPROC @TOKAPEN TAB1*TABLE ;
  21299. *
  21300. *******************************************************************
  21301. * Procedure de prise en compte sommaire de la penetration. *
  21302. * Pour cela, on calcule un profil de flux supplementaire que l'on *
  21303. * ajoutera au profil calcule par @TOKAFLU sur une surface donnee. *
  21304. * Alain MOAL (decembre 1995) *
  21305. *******************************************************************
  21306. *
  21307. MESS '---------------------------------> calling @TOKAPEN';
  21308. *
  21309. *--------------- VARIABLES D'ENTREE :
  21310. SURF0 = TAB1.LFLUX_EXTE ;
  21311. SURF1 = TAB1.<LFLUX_PENE ;
  21312. DELTA = TAB1.<DIST_DSMF ;
  21313. LAMBQ = TAB1.<LONG_DECROIS ;
  21314. VBVN = TAB1.<VBVN ;
  21315. COEF0 = TAB1.<COEFCONS ;
  21316. SI ((VALEUR DIME) EGA 3) ;
  21317. OEIL0 = TAB1.VIEW_P ;
  21318. FINSI ;
  21319. *------------------------------------
  21320. *
  21321. *---- Creation d'un masque sur SURF0
  21322. MASQ1 = DELTA * 0. ;
  21323. *---- Creation d'un masque sur SURF1
  21324. X0 = COOR 1 SURF1 ;
  21325. MASQ2 = X0 * 0. + 1. ;
  21326. *
  21327. MASQ0 = MASQ1 + MASQ2 ;
  21328. PROFIL0 = (EXP (-1.*DELTA/LAMBQ)) * VBVN * COEF0;
  21329. PROFPEN0 = MASQ0 * (EXP (-1.*DELTA/LAMBQ)) * VBVN * COEF0;
  21330. PROFTOT0 = PROFIL0 + PROFPEN0 ;
  21331. SI (EGA (VALEUR DIME) 3) ;
  21332. ARET1 = ARETE SURF0 ;
  21333. TITRE '@TOKAPEN : PROFILE OF THE INCIDENT HEAT FLUX';
  21334. TRACE CACH OEIL0 7 PROFTOT0 SURF0 ARET1 ;
  21335. FINSI ;
  21336. MESS '---------------------------------> exiting @TOKAPEN';
  21337. FINPROC PROFPEN0 ;
  21338. debproc @tokpltg geo1*maillage tab1*table delt_phi*flottant delt_the*flottant;
  21339.  
  21340. * R. Mitteau 23.06.1997
  21341. * cette proc\E9dure calcule le plan tangent aux surfaces magnetiques
  21342. * avec shift et avec ripple
  21343. * elle utilise les notations de tokaflu
  21344. *
  21345. * geo1 est suppose defini dans le repere du ripple
  21346. * elle ne marche qu'en 3 D
  21347. * *******************************************************
  21348. *
  21349. * --- recuperatiion donn\E9es
  21350. *
  21351. COEFA = TAB1.<COEFA ;
  21352. COEFB = TAB1.<COEFB ;
  21353. COEFC = TAB1.<COEFC ;
  21354. ANGPHI0 = TAB1.<ANGPHI0 ;
  21355. NBOB = TAB1.<NBOB ;
  21356. EPS = TAB1.<EPS ;
  21357. NBOB = TAB1.<NBOB ;
  21358. rho0 = TAB1.<RHO0 ;
  21359. g_lamb1 = TAB1.<LAMB ;
  21360. RP1 = TAB1.<RP ;
  21361. *
  21362. * --- calcul des coordonnees de geo1 dans le repere du ripple
  21363. *
  21364. xg yg zg = @crmgc (coor 1 geo1) (coor 2 geo1) (coor 3 geo1) tab1 ;
  21365. rho_ar theta_ar phi_ar = @crgtc xg yg zg 2.2 0.;
  21366. *
  21367. * --- calcul du rhomer, ligne de code pique a @chamb
  21368. *
  21369.  
  21370. RHO_OLD = RHO_aR ;
  21371. KAUX = (EXP(THETA_aR**2 * -1. * COEFC)) * ((COS((PHI_aR + ANGPHI0) * NBOB)) * -1. + 1.) * COEFA ;
  21372. I = 0 ;
  21373. IMAX = 50 ;
  21374. REPETER BOUCLE IMAX ;
  21375. I = I + 1;
  21376. RHO_NEW = RHO_aR + (KAUX * (EXP(RHO_OLD * COEFB))) ;
  21377. SI ((MAXI (ABS((RHO_NEW - RHO_OLD) / RHO_NEW))) &lt;EG EPS) ;
  21378. QUITTER BOUCLE ;
  21379. FINSI ;
  21380. RHO_OLD = RHO_NEW ;
  21381. FIN BOUCLE ;
  21382. SI (I >EG IMAX) ;
  21383. MESS '>>> @CHAMB : NO CONVERGENCE OF THE ITERATIVE METHOD !';
  21384. ERRE ' >>> STOP IN @CHAMB';
  21385. FINSI ;
  21386. RHOMER = RHO_NEW ;
  21387. *
  21388. * --- calcul du premier vecteur tangent a la surface magnetique par
  21389. * variation de phi - l'effet dont il faut
  21390. * tenir compte est le ripple du champ magnetique
  21391. *
  21392. * - _app signifie a plus phi, point cote plus dans le sens toroidal
  21393. *
  21394. the_app = theta_ar ;
  21395. phi_app = phi_ar + delt_phi ;
  21396. rho_app = RHOMER + (COEFA * (exp((COEFB * RHOMER)-(coefc * the_app * the_app))) * ((cos (nbob * phi_app)) - 1.));
  21397.  
  21398. * - _app signifie a moins phi, point cote moins dans le sens toroidal
  21399.  
  21400. the_amp = theta_ar ;
  21401. phi_amp = phi_ar - delt_phi ;
  21402. rho_amp = RHOMER + (COEFA * (exp((COEFB * RHOMER)- (coefc * the_amp * the_amp))) * ((cos (nbob * phi_amp)) - 1.));
  21403.  
  21404.  
  21405. * on repasse dans la base globale
  21406.  
  21407. ppx1 ppy1 ppz1 = @crtgc rho_app the_app phi_app 2.2 0. ;
  21408. pmx1 pmy1 pmz1 = @crtgc rho_amp the_amp phi_amp 2.2 0. ;
  21409.  
  21410. * par difference, on calcule les coordonnee du premier vecteur tangent
  21411.  
  21412. v1gx = ppx1 - pmx1;
  21413. v1gy = ppy1 - pmy1 ;
  21414. v1gz = ppz1 - pmz1 ; ;
  21415.  
  21416. * on repasse dans la base du maillage
  21417.  
  21418. v9mx v9my v9mz = @cbgmv v1gx v1gy v1gz tab1 ;
  21419.  
  21420. * on le normalise
  21421.  
  21422. norm1 =(( v9mx*v9mx)+(v9my*v9my)+(v9mz*v9mz)) ** .5 ;
  21423. v1mx = v9mx / norm1 ;
  21424. v1my = v9my / norm1 ;
  21425. v1mz = v9mz / norm1 ;
  21426.  
  21427.  
  21428. *
  21429. * --- calcul du deuxieme vecteur tangent a la surface magnetique par
  21430. * variation de theta - l'effet principal dont il faut
  21431. * tenir compte est le shift de Shafranov
  21432. *
  21433.  
  21434. * calcul du petit rayon "sous les bobines" de la surface magnetique
  21435. * passant par A
  21436.  
  21437. rho_abob = RHOMER + (COEFA * (exp((COEFB * RHOMER)-(coefc * the_app * the_app))) * ( -2.));
  21438.  
  21439. * calcul du decentrement de ces surfaces par la formule de Safranov
  21440.  
  21441. terme1 = log (rho_abob / rho0 ) ;
  21442. facteu1 = g_lamb1 + .5 ;
  21443. facteu2 = 1. - ((rho_abob/ rho0) ** -2) ;
  21444. terme2 = terme1 + (facteu1 * facteu2) ;
  21445. * delt1 est le decentrement
  21446. delt1 = (rho_abob ** 2) * terme2 / (2. * RP1) ;
  21447. rp2 = RP1 - delt1 ;
  21448.  
  21449. * calcul du petit rayon de la surface magnetique de A
  21450. * (relation dans le triangle)
  21451.  
  21452. pr2 = ((rho_abob * rho_abob) + ((rp2 - 2.2) * (rp2 - 2.2)) - (2. * rho_ar * (rp2 - 2.2) *( cos (theta_ar)))) ** .5 ;
  21453.  
  21454. * calcul de l'angle theta des points de geo1 dans le repere
  21455. * pseudotoroidal de grand rayon le centre de la surface magnetique
  21456.  
  21457. coth2 = ((pr2 * pr2) + ((rp2 - 2.2) * (rp2 - 2.2)) - (rho_abob * rho_abob)) / (-2. * pr2 * (rp2 - 2.2));
  21458.  
  21459. sith2 = (1. - (coth2 * coth2)) ** .5 ;
  21460.  
  21461. theta_ap = atg sith2 coth2 ;
  21462.  
  21463. * les masques servent a bien avoir un theta entre -180 et +180,
  21464. * parce que le sinus calcule par la formule 1 - cos carre
  21465. * est forcement positif, ce qui me donne un theta compris entre
  21466. * 0 et 180.
  21467.  
  21468. masq_p = masq theta_ar egsupe 0. ;
  21469. masq_m = masq theta_ar inferieur 0. ;
  21470.  
  21471. theta_as = (masq_p * theta_ap) - ( theta_ap * masq_m );
  21472.  
  21473. * _apt signifie a plus theta
  21474. * _amt signifie a moins theta
  21475.  
  21476. the_apt = theta_as + delt_the ;
  21477. the_amt = theta_as - delt_the ;
  21478.  
  21479. * on repasse dans le repere du ripple !
  21480.  
  21481. * calcul des petits rayon des points dans le repere du ripple
  21482. * (toujours la formule du triangle, faire le dessin pour
  21483. * comprendre le cos (180. - the_apt) que je n'ai pas remplace par
  21484. * - cos the_apt pour la lisibilite de la procedure.
  21485.  
  21486. pr3_apt = ((pr2 * pr2) + ((rp2 - 2.2) * (rp2 - 2.2)) - (2. * pr2 * (rp2 - 2.2) *( cos (180. - the_apt)))) ** .5 ;
  21487.  
  21488. pr3_amt = ((pr2 * pr2) + ((rp2 - 2.2) * (rp2 - 2.2)) - (2. * pr2 * (rp2 - 2.2) *( cos (180. - the_amt)))) ** .5 ;
  21489.  
  21490. * calcul des theta dans le repere du ripple
  21491.  
  21492. coth2apt = ((pr3_apt * pr3_apt) + ((rp2 - 2.2) * (rp2 - 2.2)) - (pr2 * pr2)) / (2. * pr3_apt * (rp2 - 2.2));
  21493.  
  21494. coth2amt = ((pr3_amt * pr3_amt) + ((rp2 - 2.2) * (rp2 - 2.2)) - (pr2 * pr2)) / (2. * pr3_amt * (rp2 - 2.2));
  21495.  
  21496. sith2apt = (1. - (coth2apt * coth2apt)) ** .5 ;
  21497. sith2amt = (1. - (coth2amt * coth2amt)) ** .5 ;
  21498.  
  21499. thetaapt = atg sith2apt coth2apt ;
  21500. thetaamt = atg sith2amt coth2amt ;
  21501.  
  21502. the_apt = (masq_p * thetaapt) - ( thetaapt * masq_m );
  21503. the_amt = (masq_p * thetaamt) - ( thetaamt * masq_m );
  21504.  
  21505. * par la methode du point fixe, je peux calculer leur rho meridien
  21506. * pr4 est le prefixe pour des valeurs de rho meridien
  21507.  
  21508. RHO_OLD = pr3_apt ;
  21509. KAUX = (EXP(the_apt**2 * -1. * COEFC)) * 2. * COEFA ;
  21510. I = 0 ;
  21511. IMAX = 50 ;
  21512. REPETER BOUCLE IMAX ;
  21513. I = I + 1;
  21514. RHO_NEW = pr3_apt + (KAUX * (EXP(RHO_OLD * COEFB))) ;
  21515. SI ((MAXI (ABS((RHO_NEW - RHO_OLD) / RHO_NEW))) &lt;EG EPS) ;
  21516. QUITTER BOUCLE ;
  21517. FINSI ;
  21518. RHO_OLD = RHO_NEW ;
  21519. FIN BOUCLE ;
  21520. SI (I >EG IMAX) ;
  21521. MESS '>>> @CHAMB : NO CONVERGENCE OF THE ITERATIVE METHOD !';
  21522. ERRE ' >>> STOP IN @CHAMB';
  21523. FINSI ;
  21524. pr4_apt = RHO_NEW ;
  21525.  
  21526. RHO_OLD = pr3_amt ;
  21527. KAUX = (EXP(the_amt**2 * -1. * COEFC)) * 2. * COEFA ;
  21528. I = 0 ;
  21529. IMAX = 50 ;
  21530. REPETER BOUCLE IMAX ;
  21531. I = I + 1;
  21532. RHO_NEW = pr3_amt + (KAUX * (EXP(RHO_OLD * COEFB))) ;
  21533. SI ((MAXI (ABS((RHO_NEW - RHO_OLD) / RHO_NEW))) &lt;EG EPS) ;
  21534. QUITTER BOUCLE ;
  21535. FINSI ;
  21536. RHO_OLD = RHO_NEW ;
  21537. FIN BOUCLE ;
  21538. SI (I >EG IMAX) ;
  21539. MESS '>>> @CHAMB : NO CONVERGENCE OF THE ITERATIVE METHOD !';
  21540. ERRE ' >>> STOP IN @CHAMB';
  21541. FINSI ;
  21542. pr4_amt = RHO_NEW ;
  21543.  
  21544. * il n y a plus qu'a calculer le rho de ces points au bon phi par la
  21545. * formule de ripple
  21546.  
  21547. pr5_apt = COEFA * (exp((COEFB * pr4_apt)-(coefc * the_apt * the_apt))) * ((cos (nbob * phi_ar)) - 1.);
  21548.  
  21549. pr5_amt = COEFA * (exp((COEFB * pr4_amt)-(coefc * the_amt * the_amt))) * ((cos (nbob * phi_ar)) - 1.);
  21550.  
  21551. * on a maintenant les coordonnee des tous les points dans le repere
  21552. * du ripple pr5_apt; the_apt , phi_ar et pr5_amt; the_amt , phi_ar
  21553.  
  21554. * on repasse dans la base globale
  21555.  
  21556. p1gx p1gy p1gz = @cbtgv pr5_apt the_apt phi_ar the_apt phi_ar ;
  21557. p2gx p2gy p2gz = @cbtgv pr5_amt the_amt phi_ar the_amt phi_ar;
  21558.  
  21559. * on calcule par difference les vecteurs dan le repere global
  21560.  
  21561. v2gx = p1gx - p2gx ;
  21562. v2gy = p1gy - p2gy ;
  21563. v2gz = p1gz - p2gz ;
  21564.  
  21565. * on repasse dans la base du maillage
  21566.  
  21567. v9mx v9my v9mz = @cbgmv v2gx v2gy v2gz tab1 ;
  21568.  
  21569. * on le normalise
  21570.  
  21571. norm1 =(( v9mx*v9mx)+(v9my*v9my)+(v9mz*v9mz)) ** .5 ;
  21572. v2mx = v9mx / norm1 ;
  21573. v2my = v9my / norm1 ;
  21574. v2mz = v9mz / norm1 ;
  21575.  
  21576.  
  21577. * --- le produit vectoriel des deux vecteurs tangent a la surface
  21578. * donne la normale aux surfaces magnetiques
  21579. *
  21580. v3mx = (v1my * v2mz) - (v1mz * v2my);
  21581. v3my = (v1mz * v2mx) - (v1mx * v2mz) ;
  21582. v3mz = (v1mx * v2my) - (v1my * v2mx) ;
  21583.  
  21584. *norm1 =(( v3mx*v3mx)+(v3my*v3my)+(v3mz*v3mz)) ** .5 ;
  21585. *list norm1 ;
  21586. finproc v3mx v3my v3mz;
  21587. **** @TONG75
  21588. DEBPROC @TONG75 TAB_1*TABLE ;
  21589. MESS ' ';
  21590. *23456789012345678901234567890123456789012345678901234567890123456789012
  21591. * 1 2 3 4 5 6 7
  21592. ****** PROCEDURE @TONG75 ******
  21593. ********************************************************************
  21594. * CALCUL DU FLUX CRITIQUE SUIVANT LA CORRELATION DE TONG 75
  21595. *-------------------------------------------------------------------
  21596. *
  21597. *
  21598. *
  21599. TIN = TAB_1.'T_IN' ;
  21600. VIN = TAB_1.'V_LOCAL' ;
  21601. TLOCAL = TAB_1.'T_LOCAL' ;
  21602. POUT = TAB_1.'P_LOCAL' ;
  21603. D1 = TAB_1.'D_MAQUETTE' ;
  21604. EL = TAB_1.'L_HEATED' ;
  21605. XL1 = TAB_1.'WE_HEATED' ;
  21606. NIVEAU = TAB_1.'NIVEAU' ;
  21607. HLOCAL = TAB_1.'HLOCAL' ;
  21608. *
  21609. SI (NIVEAU >EG 4) ;
  21610. MESS '-----------------------------------> calling @TONG75';
  21611. FINSI ;
  21612.  
  21613. SI ( NON ( EXISTE TAB_1 TWIST_RATIO ) ) ;
  21614. TAB_1 . TWIST_RATIO = 0. ;
  21615. MESS '>@TONG75> TAB1.TWIST_RATIO set to default value : 0' ;
  21616. FINSI ;
  21617. YTWIST = TAB_1 . TWIST_RATIO ;
  21618.  
  21619. SI ( NON ( EXISTE TAB_1 T_TAPE ) ) ;
  21620. TAB_1 . T_TAPE = 0. ;
  21621. MESS '>@TONG75> TAB1.T_TAPE set to default value : 0' ;
  21622. FINSI ;
  21623. TTAPE = TAB_1 . T_TAPE ;
  21624.  
  21625. SI ( NON ( EXISTE TAB_1 I_CORR_SANDIA ) ) ;
  21626. TAB_1 . I_CORR_SANDIA = 0. ;
  21627. MESS '>@TONG75> TAB1.I_CORR_SANDIA set to default value : 0' ;
  21628. FINSI ;
  21629. ICORSA = TAB_1 . I_CORR_SANDIA ;
  21630.  
  21631. SI( NON ( EXISTE TAB1 I_RANGE )) ;
  21632. TAB1 . I_RANGE = 1 ;
  21633. FINSI ;
  21634. IVALI = TAB_1 . I_RANGE ;
  21635.  
  21636. SI( NON ( EXISTE TAB1 I_NIV_TONG75 )) ;
  21637. TAB1 . I_NIV_TONG75 = 1 ;
  21638. FINSI ;
  21639. INIVEAU = TAB_1 . I_NIV_TONG75 ;
  21640.  
  21641. SI ( NON ( EXISTE TAB_1 HELI_WIRE ) ) ;
  21642. TAB_1.HELI_WIRE = FAUX ;
  21643. MESS '>@TONG75> TAB1.HELI_WIRE set to default value : FAUX' ;
  21644. FINSI ;
  21645.  
  21646. SI ( NON ( EXISTE TAB_1 HYPERVAP ) ) ;
  21647. TAB_1.HYPERVAP = FAUX ;
  21648. MESS '>@TONG75> TAB1.HYPERVAP set to default value : FAUX' ;
  21649. FINSI ;
  21650.  
  21651. SI ( NON ( EXISTE TAB_1 FRICT_FAC ) ) ;
  21652. TAB_1.FRICT_FAC = FAUX ;
  21653. MESS '>@TONG75> TAB1.FRICT_FAC set to default value : FAUX' ;
  21654. FINSI ;
  21655. MESS ' ' ;
  21656.  
  21657. SI ( NON ( EXISTE TAB_1 DESACT_RANGE ) ) ;
  21658. DESACT1 = FAUX ;
  21659. MESS '>@TONG75> TAB1.FRICT_FAC set to default value : FAUX' ;
  21660. SINON;
  21661. DESACT1 = VRAI ;
  21662.  
  21663. FINSI ;
  21664. MESS ' ' ;
  21665.  
  21666. SI (NON DESACT1 ) ;
  21667.  
  21668. * Test sur les entrees pour s'assurer que les conditions d'entree
  21669. * ne s'ecartent pas trop du domaine de definition de TONG75
  21670.  
  21671.  
  21672. * - test sur la vitesse de l'eau
  21673. SI ((VIN < 2.) OU (VIN > 20.)) ;
  21674. MESS 'Water inlet velocity out of Tong75 range 2.- 20.' ;
  21675. ERRE '@TONG75 --> Inlet velocity' ;
  21676. FINSI ;
  21677.  
  21678. * - test sur le diametre
  21679. SI ( EGA TAB_1.HYPERVAP FAUX ) ;
  21680. SI ((D1 < 5.E-3) OU (D1 > 20.E-3)) ;
  21681. MESS 'Tube diameter out of Tong75 range 5.E-3 - 20.E-3' ;
  21682. ERRE '@TONG75 --> Tube diameter' ;
  21683. FINSI ;
  21684. FINSI ;
  21685.  
  21686. * - test sur la Pression
  21687. SI ((POUT < 5.E5) OU (POUT > 42.E5)) ;
  21688. MESS 'Water pressure out of Tong75 range 5.E5 - 42.E5' ;
  21689. ERRE '@TONG75 --> Pressure' ;
  21690. FINSI ;
  21691.  
  21692. * - test sur la temperature
  21693. TSAT = @IPOE POUT TAB_1.EPTSAT ;
  21694. DT1 = TSAT - TLOCAL ;
  21695. SI ((DT1 < 0.) OU (DT1 > 250.)) ;
  21696. MESS 'Temperature out of Tong75 range 0. - 250.' ;
  21697. ERRE '@TONG75 --> Temperature' ;
  21698. FINSI ;
  21699.  
  21700. FINSI ;
  21701. SI ( IVALI EGA 1 ) ;
  21702.  
  21703. ISAUT = 0 ;
  21704. SI ( ( POUT < 2.E5 ) OU ( POUT > 190.E5 ) ) ;
  21705. MESS '>@TONG75> PRESSURE REALLY OUT OF TONG75 RANGE POUT = ' POUT;
  21706. MESS '>@TONG75> PRESSURE RANGE 2.E5 - 190.E5 ' ;
  21707. ISAUT = 1 ;
  21708. FINSI ;
  21709. SI ( EGA TAB_1.HYPERVAP FAUX ) ;
  21710. SI ( ( D1 < 2.E-3 ) OU ( D1 > 45.E-3 ) ) ;
  21711. MESS '>@TONG75> DIAMETER REALLY OUT OF TONG75 RANGE DIAM = ' D1 ;
  21712. MESS '>@TONG75> DIAMETER RANGE 2.E-3 - 45.E-3 ' ;
  21713. ISAUT = 1 ;
  21714. FINSI ;
  21715. FINSI ;
  21716. SI ( ( EL < 0.15 ) OU ( EL > 3.7 ) ) ;
  21717. MESS '>@TONG75> LENGTH REALLY OUT OF TONG75 RANGE EL = ' EL ;
  21718. MESS '>@TONG75> LENGTH RANGE 0.15 - 3.7 ' ;
  21719. ISAUT = 1 ;
  21720. FINSI ;
  21721. FINSI ;
  21722.  
  21723. * Fin des tests sur les entrees de @TONG75
  21724.  
  21725. PI = 3.14159 ;
  21726. *
  21727. SI ( ( YTWIST EGA 0. ) ET ( EGA TAB_1.HYPERVAP FAUX ) ) ;
  21728. TAB_1.DHC = D1 ;
  21729. S1 = PI * D1 * D1 / 4. ;
  21730. TAB_1.DH = D1 ;
  21731. FACV = 1. ;
  21732. FACS = 1.25 ;
  21733. TAB_1.M_TONG = MOT '1.25*TONG75' ;
  21734. FINSI ;
  21735. SI ( ( YTWIST EGA 0. ) ET ( EGA TAB_1.HELI_WIRE VRAI ) ) ;
  21736. S1 = PI * D1 * D1 / 4. ;
  21737. SM = PI * TAB_1.WIRE_D * TAB_1.WIRE_D / 4. ;
  21738. P1 = PI * D1 ;
  21739. PM = PI * TAB_1.WIRE_D ;
  21740. TAB_1.DH = 4. * ( S1 - SM ) / ( P1 + PM ) ;
  21741. PIS2Y = PI / ( 2 * TAB_1.PITCH_WIRE ) ;
  21742. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  21743. * FACV = 1. ;
  21744. FACF = 1. ;
  21745. FINSI ;
  21746. *
  21747. SI ( ( TAB_1.TWIST_RATIO EGA 0. 1.E-6 ) ET ( EGA TAB_1.HYPERVAP VRAI ) ) ;
  21748. SM = ( TAB_1 . LARG_CANAL * TAB_1 . HMIN_CANAL ) + ( 2. * ( TAB_1 . LARG_ESP * TAB_1 . HFIN ) ) ;
  21749. PM = TAB_1 . LARG_CANAL + ( 2.* TAB_1 . HMAX_CANAL ) + ( 2. * TAB_1 . LARG_ESP ) + ( 2. * TAB_1 . HFIN ) + TAB_1 . LFIN ;
  21750. TAB_1.DH = 4. * SM / PM ;
  21751. FACV = 1. ;
  21752. FACF = 1. ;
  21753. TAB_1.HYP_SM = SM ;
  21754. FACS = 1. ;
  21755. TAB_1.M_TONG = MOT 'TONG75' ;
  21756. FINSI ;
  21757. *
  21758. SI ( YTWIST > 0. ) ;
  21759. SI ( NON ( EXISTE TAB_1 'N_CANAUX' )) ;
  21760. TAB_1 . N_CANAUX = 2. ;
  21761. FINSI ;
  21762. SS2 = ( ( PI * D1 * D1 / 8.) - ( TTAPE * D1 / 2. ) ) ;
  21763. S1 = SS2 * TAB_1 . N_CANAUX ;
  21764. QUAS = 4. * SS2 ;
  21765. PERI = ( ( PI * D1 / 2.) - TTAPE + D1 ) ;
  21766. TAB_1.DH = QUAS / PERI ;
  21767. TAB_1.DHC = 4. * ( ( PI * D1 * D1 / 4.) - ( TTAPE * D1 ) ) / ( ( PI * D1 ) - ( TTAPE * 2.) ) ;
  21768. PIS2Y = PI / ( 2. * YTWIST ) ;
  21769. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  21770. * FACF = 1.15 ;
  21771. FACS = 1.67 ;
  21772. TAB_1.M_TONG = MOT '1.67*TONG75' ;
  21773. FINSI ;
  21774. *-----------------
  21775. VP = VIN * FACV ;
  21776. *-----------------
  21777.  
  21778. SI (( YTWIST > 0. ) ET ( ICORSA EGA 1 ) ) ;
  21779. CORR = SCALE * 2.75 * ( YTWIST ** ( -0.406 ) ) ;
  21780. SI ( CORR &lt;EG 1. ) ;
  21781. CORR = 1. ;
  21782. FINSI ;
  21783. SINON ;
  21784. CORR = 1. ;
  21785. FINSI ;
  21786.  
  21787. RHOIN = @IPOE TIN TAB1.ETRHOF ;
  21788. HSAT = @IPOE TSAT TAB_1.ETHF ;
  21789. RHOGSAT = @IPOE TSAT TAB_1.ETRHOG ;
  21790. GIN = RHOIN * VIN ;
  21791. NNU = @IPOE TLOCAL TAB_1.ETNNU ;
  21792. PR = @IPOE TLOCAL TAB_1.ETPRAF ;
  21793. *HFG = @IPOE TLOCAL TAB_1.ETHFG ;
  21794. HFG = @IPOE TSAT TAB_1.ETHFG ;
  21795. * RHOF rho de l eau a TLOCAL PTRHO PRHOF
  21796. RHOF = @IPOE TLOCAL TAB_1.ETRHOF ;
  21797. RHOFSAT = @IPOE TSAT TAB_1.ETRHOF ;
  21798. DTSUBC = TSAT - TLOCAL ;
  21799.  
  21800. *Reynolds number based on inlet velocity used in QCHFW1 and QCHFW3
  21801. REF = ( RHOF * VIN * TAB_1.DH ) / NNU ;
  21802.  
  21803. * Friction factor calculation
  21804. SI ( EGA TAB_1.FRICT_FAC VRAI ) ;
  21805. FA = 4. * 1.375E-3 * (( 1. + ( 21.544 * ( 0.00375 /( TAB_1.DH * 1000. / 2. ))) + ( 100. / REF )) ** ( 1. / 3. )) ;
  21806. TAB_1.SSIGM = @IPOE TSAT TAB_1.ETSIGM ;
  21807. SIGM = TAB_1.SSIGM ;
  21808. RHOFSAT = @IPOE TSAT TAB_1.ETRHOF ;
  21809. REPETER BOUCFA 100 ;
  21810. RADEFF = 1.14 - ( 2. * ( LOG ((( 0.72 * SIGM * RHOFSAT ) / ( FA * TAB_1.DH * ( GIN**2 ))) + ( 9.35 / ( REF *( FA **( 1. / 2. ))))))/( LOG 10 )) ;
  21811. DIF1 = ( RADEFF ** (-2))- FA ;
  21812. DELTAF = ABS (DIF1) ;
  21813. FA = RADEFF**(-2) ;
  21814. TAB_1.FFA = FA ;
  21815. SI (DELTAF &lt;EG 1.E-6) ;
  21816. QUITTER BOUCFA ;
  21817. FINSI ;
  21818. FIN BOUCFA ;
  21819. QCHFW1 = TAB_1.FFA ;
  21820. SINON ;
  21821. *Reference diameter (0.5 inch) used for friction factor coefficient
  21822. DOM = 12.7E-3 ;
  21823. DRATIO = TAB_1.DH / DOM ;
  21824. QCHFW1 = 8. * ( REF ** ( -.6 ) ) * ( DRATIO ** .32 ) ;
  21825. FINSI ;
  21826. *Water critical pressure
  21827. PCRIT = 22.09E6 ;
  21828. PRATIO = POUT / PCRIT ;
  21829. XOUT = -1. * ( HSAT - HLOCAL ) / HFG ;
  21830. *>> 30.8.93 correction erreur sur JA
  21831. *JA = -1. * XOUT * ( RHOFSAT / RHOGSAT ) ;
  21832. JA = -1. * XOUT * ( RHOF / RHOGSAT ) ;
  21833. QCHFW3 = 1. + ( .00216 * ( PRATIO ** 1.8 ) * ( REF ** .5 ) * JA ) ;
  21834. QCHFW2 = 0.23 * GIN * HFG ;
  21835. QCHFW = FACS * CORR * QCHFW1 * QCHFW2 * QCHFW3 ;
  21836.  
  21837. *Expression using REV
  21838. *Reynolds number based on swirl velocity
  21839. REV = ( RHOF * VP * TAB_1.DH ) / NNU ;
  21840. *QCHFW3 = 1. + ( .00216 * ( PRATIO ** 1.8 ) * ( REV ** .5 ) * JA ) ;
  21841. *QCHFW1 = 8. * ( REV ** ( -.6 ) ) * ( DRATIO ** .32 ) ;
  21842. *QCHFW = FACS * CORR * QCHFW1 * QCHFW2 * QCHFW3 ;
  21843.  
  21844. *QCHFW = ( 0.9 * QCHFW ) + ( 0.1 * QOLD ) ;
  21845. *QSURFE = QCHFW * KQ ;
  21846. *QSURFI = QSURFE * XL1 / PERCH ;
  21847. *DQSQ = ( QCHFW - QOLD ) / QCHFW ;
  21848. *NUS = 0.023 * ( REV ** 0.8 ) * ( PR ** 0.4 ) ;
  21849. *NUS = NUS * FACV * FACF ;
  21850. *FACD = ( D1 / DH ) ** 0.2 ;
  21851. *FACT = FACV * FACD * FACF ;
  21852.  
  21853. SI ( INIVEAU >EG 1 ) ;
  21854. MESS ' ' ;
  21855. MESS '>@TONG75> THERMAL HYDRAULIC CONDITIONS ' ;
  21856. MESS ' ' ;
  21857. MESS '>@TONG75> INLET VELOCITY (m/s) : ' VIN ;
  21858. * MESS '>@TONG75> INLET MASS FLOW RATE (kg/s) : '
  21859. * (VIN * S1 * RHOIN) ;
  21860. * MESS '>@TONG75> FLUID INLET TEMPERATURE (C) : ' TIN ;
  21861. MESS '>@TONG75> FLUID LOCAL TEMPERATURE (C) : ' TLOCAL;
  21862. MESS '>@TONG75> FLUID OUTLET PRESSURE (Pa) : ' POUT ;
  21863. MESS '>@TONG75> WATER SATURATION TEMPERATURE (C) : ' TSAT ;
  21864. MESS '>@TONG75> SUBCOOLING TSAT - TLOCAL (C) : ' DTSUBC;
  21865. MESS ' ' ;
  21866. MESS '>@TONG75> GEOMETRICAL CONDITIONS ' ;
  21867. MESS ' ' ;
  21868. MESS '>@TONG75> TUBE DIAMETER (m) : ' D1 ;
  21869. MESS '>@TONG75> TUBE HYDRAULIC DIAMETER (m) : ' TAB_1.DH ;
  21870. * MESS '>@TONG75> TUBE HEATED EQU. DIAMETER (m) : ' TAB_1.DHC ;
  21871. MESS '>@TONG75> HEATED LENGTH (m) : ' EL ;
  21872. MESS '>@TONG75> HEATED WIDTH (m) : ' XL1 ;
  21873. MESS '>@TONG75> SWIRL TAPE THICKNESS (m) : ' TTAPE ;
  21874. MESS '>@TONG75> TWIST RATIO : ' YTWIST ;
  21875. SI ( INIVEAU >EG 2 ) ;
  21876. MESS '>@TONG75> REYNOLDS NUMBER BASED ON SWIRL VELOCITY : ' REV;
  21877. MESS '>@TONG75> REYNOLDS NUMBER BASED ON VIN : ' REF ;
  21878. MESS '>@TONG75> QUALITY : ' XOUT;
  21879. MESS '>@TONG75> JAKOB NUMBER : ' JA ;
  21880. MESS '>@TONG75> PRANDTL NUMBER : ' PR ;
  21881. MESS '>@TONG75> CORRECTIVE FACTOR SANDIA : ' CORR;
  21882. SI ( INIVEAU >EG 3 ) ;
  21883. MESS '>@TONG75> LOCAL FLUID DENSITY (kg/m**3) : ' RHOF ;
  21884. MESS '>@TONG75> GAS SATUR. DENSITY (kg/m**3) : ' RHOGSAT ;
  21885. MESS '>@TONG75> VAPORISATION ENTHALPY (J/kg) : ' HFG ;
  21886. MESS '>@TONG75> OUTLET FLUID VISCOSITY (kg/m.s) : ' NNU ;
  21887. MESS '>@TONG75> Q1 Q2 Q3 ' QCHFW1 QCHFW2 QCHFW3 ;
  21888. FINSI ;
  21889. FINSI ;
  21890. MESS ' ' ;
  21891. MESS '>@TONG75> : ' TAB_1.M_TONG;
  21892. MESS '>@TONG75> CRITICAL HEAT FLUX (W/m2) : ' QCHFW ;
  21893. MESS ' ' ;
  21894. FINSI ;
  21895. SCALE = 0.8 ;
  21896.  
  21897. SI (QCHFW < 0) ;
  21898. MESS ' ' ;
  21899. MESS '!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!' ;
  21900. MESS ' ' ;
  21901. MESS 'ATTENTION execution incorrecte de @TONG75' ;
  21902. MESS ' ' ;
  21903. MESS '--------------------------------------------' ;
  21904. MESS ' Le flux critique est negatif ' ;
  21905. ERRE ' On arrete le calcul' ;
  21906. FINSI ;
  21907. SI( NIVEAU >EG 4) MESS '-----------------------------------> exit from @TONG75';
  21908. FINSI ;
  21909.  
  21910. *sorties ;
  21911. TAB1.CHF = QCHFW ;
  21912.  
  21913. FINPROC ;
  21914. **** TORO
  21915. DEBPROC TORO TAGEO*TABLE TABOB*TABLE ;
  21916. *
  21917. * Developpement et test de la procedure TORO
  21918. * Projet DRFC/TO_PO Contrat n 30422676
  21919. *
  21920. opti dime 3 elem cub8 echo 0 ;
  21921. **********************************************************************
  21922. * *
  21923. * T O R O *
  21924. * ------- *
  21925. * *
  21926. * Objet: *
  21927. * ----- *
  21928. * *
  21929. * Calcul de l'induction magnetique creee par un ensemble *
  21930. * de bobines circulaires ou en 'D', reparties regulierement *
  21931. * autour de l'axe Oz, en l'absence de fer. *
  21932. * *
  21933. * Syntaxe: *
  21934. * ------- *
  21935. * *
  21936. * TABCHB TAB2 = TORO TAGEO1 TABOB1 ; *
  21937. * *
  21938. * En entree : *
  21939. * *
  21940. * *
  21941. * TAGEO1 table des domaines de calcul du champ *
  21942. * TAGEO1.i geometrie ou le champ est calcule (type TABLE) *
  21943. * TAGEO1.i.'mail' : maillage de la geometrie (type MAILLAGE) *
  21944. * *
  21945. * TABOB table a deux indices contenant les donnees *
  21946. * relatives aux bobines (type TABLE) *
  21947. * .GENE table *
  21948. * .1 nbob: nombre de bobines (type ENTIER) *
  21949. * .2 b: largeur des bobines (type FLOTTANT) *
  21950. * .3 h: hauteur des bobines (type FLOTTANT) *
  21951. * .4 cbob: centre de la bobine (type POINT) *
  21952. * .5 vn: vecteur normal au plan de la bobine (type POINT)*
  21953. * .6 tsol: table des solenations des bobines *
  21954. * .i solenation (courant * nombre de spires) *
  21955. * de la bobine i (type FLOTTANT) *
  21956. * .7 rt: rayon du tore (type FLOTTANT) *
  21957. * .8 ri: nombre de bobines (type FLOTTANT) *
  21958. * .TYPE 'c' pour une bobine circulaire *
  21959. * 'd' pour une bobine en 'D' *
  21960. * .TRAC1 si oui : trace du maillage des bobines (type LOGIQUE) *
  21961. * .CBIOT si oui : calcul de l'induction magnetique *
  21962. * .D = troncon : table des troncons: *
  21963. * troncon.j = troncj : table du troncon j: *
  21964. * troncj.'l' longueur du troncon si rectiligne, *
  21965. * .'r' rayon de courbure et *
  21966. * .'alpha' angle de courbure si courbe *
  21967. * *
  21968. * En sortie : *
  21969. * *
  21970. * *
  21971. * TABCHB table contenant (type TABLE) *
  21972. * i champ de Biot et Savart relatif au i-eme *
  21973. * maillage GEO1 (type CHPOINT) *
  21974. * *
  21975. * TAB2 table contenant (type TABLE) *
  21976. * BOBMAI.i maillage de chaque bobine (type MAILLAGE) *
  21977. * CONT.j ensemble des coupes sur le plan j *
  21978. * (type MAILLAGE) *
  21979. * *
  21980. * Remarques: *
  21981. * --------- *
  21982. * *
  21983. * Les grandeurs suivantes sont "en dur" dans la procedure : *
  21984. * *
  21985. * NELE nombre d'elements generes lors des rotations *
  21986. * et des translations effectuees pendant la *
  21987. * creation du maillage des bobines. *
  21988. * *
  21989. * COEF1 coefficient etablissant la distance critique *
  21990. * de selection des points lors de la recherche *
  21991. * de contour. *
  21992. * *
  21993. **********************************************************************
  21994. isym = 0 ;
  21995. *
  21996. * Valeurs de quelques constantes
  21997. *
  21998. pi = 3.1415926 ;
  21999. mu0 = 4.e-7 * pi ;
  22000. eps = 1.e-3 ;
  22001. nele = 4 ;
  22002. alpha = 90. ;
  22003. oeil = 100. 20. 10. ;
  22004. *
  22005. * creation du maillage
  22006. *
  22007. tab2 = table ;
  22008. tabmai = table ;
  22009. tab2.bobmai = tabmai ;
  22010. ibob = 1 ;
  22011. repeter proc 1 ;
  22012. sauter 1 ligne ;
  22013. mess ' ************ procedure TORO' ;
  22014. sauter 1 ligne ;
  22015. ngeo = dime tageo1 ;
  22016. si (ega ngeo 0) ;
  22017. *tc il ajout d' une quote en fin de la ligne suivante
  22018. mess ' **** Il n y a pas de domaine de calcul ';
  22019. sinon ;
  22020. si (ega ngeo 1) ;
  22021. mess ' **** Il y a un seul domaine de calcul' ;
  22022. sinon ;
  22023. *tc idem ci dessus
  22024. mess ' **** Il y a' ngeo 'domaines de calcul' ;
  22025. finsi ;
  22026. finsi ;
  22027. si (existe tabob type) ;
  22028. typbob = tabob.type ;
  22029. sinon ;
  22030. mess ' *** erreur : indice type inexistant' ;
  22031. quitter proc ;
  22032. finsi ;
  22033. si (existe tabob gene) ;
  22034. tcara = table ;
  22035. tcara = tabob.gene ;
  22036. si (existe tcara 1) ;
  22037. nbob*entier = tcara.1 ;
  22038. sinon ;
  22039. mess ' *** erreur ; il manque nbob !!' ;
  22040. quitter proc ;
  22041. finsi ;
  22042. si (existe tcara 2) ;
  22043. b*flottant = tcara.2 ;
  22044. sinon ;
  22045. mess ' *** erreur ; il manque b !!' ;
  22046. quitter proc ;
  22047. finsi ;
  22048. si (existe tcara 3) ;
  22049. h*flottant = tcara.3 ;
  22050. sinon ;
  22051. mess ' *** erreur ; il manque nbob !!' ;
  22052. quitter proc ;
  22053. finsi ;
  22054. si (existe tcara 4) ;
  22055. cbob*point = tcara.4 ;
  22056. sinon ;
  22057. mess ' *** erreur ; il manque cbob !!' ;
  22058. quitter proc ;
  22059. finsi ;
  22060. si (existe tcara 5) ;
  22061. v*point = tcara.5 ;
  22062. sinon ;
  22063. mess ' *** erreur ; il manque v !!' ;
  22064. quitter proc ;
  22065. finsi ;
  22066. si (existe tcara 6) ;
  22067. tabsol = table ;
  22068. tabsol = tcara.6 ;
  22069. sinon ;
  22070. mess ' *** erreur ; il manque tabsol !!' ;
  22071. quitter proc ;
  22072. finsi ;
  22073. si (existe tcara 7) ;
  22074. rt*flottant = tcara.7 ;
  22075. sinon ;
  22076. mess ' *** erreur ; il manque rt !!' ;
  22077. quitter proc ;
  22078. finsi ;
  22079. si (existe tcara 8) ;
  22080. ri*flottant = tcara.8 ;
  22081. sinon ;
  22082. mess ' *** erreur ; il manque ri !!' ;
  22083. quitter proc ;
  22084. finsi ;
  22085. sinon ;
  22086. mess ' *** erreur : indice gene inexistant' ;
  22087. finsi ;
  22088. *
  22089. si (ega typbob 'c') ;
  22090. sauter 1 ligne ;
  22091. mess ' ******* bobine circulaire *********' ;
  22092. sinon;
  22093. si (ega typbob 'd') ;
  22094. si (existe tabob 'd') ;
  22095. sauter 1 ligne ;
  22096. mess ' ******* bobine en D *********' ;
  22097. sauter 1 ligne ;
  22098. sinon;
  22099. mess ' erreur bobine D : indice d inexistant' ;
  22100. finsi;
  22101. sinon;
  22102. mess '********* erreur bobine ***********' ;
  22103. quitter proc ;
  22104. finsi;
  22105. finsi ;
  22106. *-----------------------------------------------------------------
  22107. * fin de l'analyse syntaxique
  22108. *-----------------------------------------------------------------
  22109. c1 c2 c3 = coor cbob ;
  22110. o1 = cbob plus (0. (0. - rt) 0.) ;
  22111. o2 = o1 plus (0. 0. 10.) ;
  22112. *
  22113. * calcul du vecteur norme vnor normal au plan de la bobine
  22114. *
  22115. v1 v2 v3 = coor v ;
  22116. *
  22117. vn = ( (v1**2) + (v2**2) + (v3**2) )**0.5 ;
  22118. si (vn ega 0.);
  22119. mess ' *** erreur: vecteur vn nul !' ;
  22120. quitter proc ;
  22121. finsi ;
  22122. vn1 = v1/vn ; vn2 = v2/vn ; vn3 = v3/vn ;
  22123. vnor = vn1 vn2 vn3 ;
  22124. ovn = o1 plus (v1 v2 v3) ;
  22125. *
  22126. * calcul du vecteur norme wn normal a vnor (dans le plan de la bobine
  22127. * et dans le plan xOy) et du vecteur t tangent au troncon
  22128. *
  22129. si (vn3 ega 0.);
  22130. t0 = 0. 0. 1. ;
  22131. wn = pvec t0 vnor ;
  22132. sinon ;
  22133. si ( (non (ega vn1 0.)) ou (non (ega vn2 0.)) ) ;
  22134. wn = pvec (0. 0. 1.) vnor ;
  22135. t0 = pvec vnor wn ;
  22136. sinon ;
  22137. wn = 0. 1. 0. ;
  22138. t0 = 1. 0. 0. ;
  22139. finsi ;
  22140. finsi ;
  22141. xt0 yt0 zt0 = coor t0 ;
  22142. t = t0 plus (0. 0. 0.) ;
  22143. wn1 wn2 wn3 = coor wn ;
  22144. *-----------------------------------------------------------
  22145. * test sur le domaine de calcul
  22146. *-----------------------------------------------------------
  22147. itest = table ;
  22148. igeo1 = 0 ;
  22149. repeter bgeo1 ngeo ;
  22150. igeo1 = igeo1 + 1 ;
  22151. si (existe tageo1 igeo1) ;
  22152. lmot = ((tageo1.igeo1).'mail') elem 'TYPE' ;
  22153. nbeldom = nbel (tageo1.igeo1).'mail' ;
  22154. nmot = dime lmot ;
  22155. imot = 0 ;
  22156. repeter boutyp nmot ;
  22157. imot = imot + 1 ;
  22158. mot1 = extr lmot imot ;
  22159. mess ' *** domaine numero' igeo1 'compose de' nbeldom 'elements ' mot1 ;
  22160. sauter 1 ligne ;
  22161. * domaine plan
  22162. si ( (ega mot1 'TRI3') ou (ega mot1 'QUA4') ou (ega mot1 'TRI6') ou (ega mot1 'QUA8') ) ;
  22163. elem1 = ((tageo1.igeo1).'mail') elem 1 ;
  22164. elem2 = chan poi1 elem1 ;
  22165. pel1 = elem2 poin 1 ;
  22166. pel2 = elem2 poin 2 ;
  22167. pel3 = elem2 poin 3 ;
  22168. zpel1 = coor 3 pel1 ;
  22169. zpel2 = coor 3 pel2 ;
  22170. zpel3 = coor 3 pel3 ;
  22171. phori = (ega zpel1 zpel2 1.E-5) et (ega zpel1 zpel3 1.E-5) ;
  22172. si (phori) ;
  22173. (tageo1.igeo1).'ZP' = zpel1 ;
  22174. (tageo1.igeo1).'PP' = pel1 ;
  22175. (tageo1.igeo1).'VP' = 0. 0. 1. ;
  22176. pequa = phori et (ega zpel1 0.) ;
  22177. si (pequa et (ega v3 0.)) ;
  22178. itest.igeo1 = 0 ;
  22179. isym = 1 ;
  22180. sinon ;
  22181. si ((ega typbob 'c') et (ega v3 0.)) ;
  22182. * calcul analytique pour une bobine circulaire verticale
  22183. itest.igeo1 = 1 ;
  22184. sinon ;
  22185. * calcul d'intersection de Denis
  22186. itest.igeo1 = 2 ;
  22187. finsi ;
  22188. finsi ;
  22189. sinon ;
  22190. itest.igeo1 = -2 ;
  22191. finsi ;
  22192. quitter boutyp ;
  22193. sinon ;
  22194. * domaine volumique
  22195. itest.igeo1 = -1 ;
  22196. finsi ;
  22197. fin boutyp ;
  22198. * sauter 1 ligne ;
  22199. * mess ' ****** itest =' itest.igeo1 ;
  22200. * sauter 1 ligne ;
  22201. sinon ;
  22202. quitter bgeo1 ;
  22203. finsi ;
  22204. fin bgeo1 ;
  22205. *--------------------------------------------------------------
  22206. * construction des points de la section initiale de la bobine
  22207. *--------------------------------------------------------------
  22208. re = ri + b ;
  22209. p11 = c1 + (ri*wn1) - ((h/2.)*vn1) ;
  22210. p12 = c2 + (ri*wn2) - ((h/2.)*vn2) ;
  22211. p13 = c3 + (ri*wn3) - ((h/2.)*vn3) ;
  22212. p21 = c1 + (re*wn1) - ((h/2.)*vn1) ;
  22213. p22 = c2 + (re*wn2) - ((h/2.)*vn2) ;
  22214. p23 = c3 + (re*wn3) - ((h/2.)*vn3) ;
  22215. p31 = c1 + (re*wn1) + ((h/2.)*vn1) ;
  22216. p32 = c2 + (re*wn2) + ((h/2.)*vn2) ;
  22217. p33 = c3 + (re*wn3) + ((h/2.)*vn3) ;
  22218. p41 = c1 + (ri*wn1) + ((h/2.)*vn1) ;
  22219. p42 = c2 + (ri*wn2) + ((h/2.)*vn2) ;
  22220. p43 = c3 + (ri*wn3) + ((h/2.)*vn3) ;
  22221. *
  22222. * points de la base
  22223. *
  22224. p1 = p11 p12 p13 ; p2 = p21 p22 p23 ;
  22225. p3 = p31 p32 p33 ; p4 = p41 p42 p43 ;
  22226. * barycentre de la base:
  22227. pp11 = (p11 + p21 + p31 + p41)/4. ;
  22228. pp12 = (p12 + p22 + p32 + p42)/4. ;
  22229. pp13 = (p13 + p23 + p33 + p43)/4. ;
  22230. pp1 = pp11 pp12 pp13 ;
  22231. *
  22232. * segments de la base
  22233. *
  22234. d1 = droi 1 p1 p2 ; d2 = droi 1 p2 p3 ;
  22235. d3 = droi 1 p3 p4 ; d4 = droi 1 p4 p1 ;
  22236. cont1 = p1 d 1 p2 d 1 p3 d 1 p4 d 1 p1 ;
  22237. *
  22238. cvn = cbob plus (vn1 vn2 vn3) ;
  22239. *-----------------------------------------
  22240. * construction des surfaces laterales
  22241. *-----------------------------------------
  22242. si (ega typbob 'c') ;
  22243. tquart = table ;
  22244. pp2 = pp1 tour alpha cbob cvn ;
  22245. *
  22246. surf1 = d1 rota nele alpha cbob cvn ;
  22247. surf2 = d2 rota nele alpha cbob cvn ;
  22248. surf3 = d3 rota nele alpha cbob cvn ;
  22249. surf4 = d4 rota nele alpha cbob cvn ;
  22250. *
  22251. surfbo1 = surf1 et surf2 et surf3 et surf4 ;
  22252. tquart.1 = surfbo1 ;
  22253. xn1 = (vn2*wn3) - (vn3*wn2) ;
  22254. xn2 = (vn3*wn1) - (vn1*wn3) ;
  22255. xn3 = (vn1*wn2) - (vn2*wn1) ;
  22256. p51 = c1 + (ri*xn1) - ((h/2.)*vn1) ;
  22257. p52 = c2 + (ri*xn2) - ((h/2.)*vn2) ;
  22258. p53 = c3 + (ri*xn3) - ((h/2.)*vn3) ;
  22259. p61 = c1 + (re*xn1) + ((h/2.)*vn1) ;
  22260. p62 = c2 + (re*xn2) + ((h/2.)*vn2) ;
  22261. p63 = c3 + (re*xn3) + ((h/2.)*vn3) ;
  22262. p5 = p51 p52 p53 ; p6 = p61 p62 p63 ;
  22263. surfbo2 = surfbo1 syme plan cbob p5 p6 ;
  22264. *
  22265. tquart.2 = surfbo2 ;
  22266. tquart.3 = surfbo2 syme plan cbob p1 p2 ;
  22267. tquart.4 = surfbo1 syme plan cbob p1 p2 ;
  22268. cont2 = cont1 syme plan cbob p5 p6 ;
  22269. demisurf = (surfbo1 et surfbo2) ;
  22270. finsi ;
  22271. *-------------------------------------------------
  22272. si (ega typbob 'd') ;
  22273. troncon = table ;
  22274. troncon = tabob.'d' ;
  22275. ntron = dime troncon ;
  22276. * mess ' ****************** Il y a' ntron 'troncons' ;
  22277. itron = 1 ;
  22278. troncj = table ;
  22279. repeter btron ntron ;
  22280. troncj = troncon.itron ;
  22281. si ( (existe troncj 'l') et (non (existe troncj 'r')) et (non (existe troncj 'alpha')) ) ;
  22282. mess ' ****** troncon no' itron 'rectiligne' ;
  22283. lj = troncj.'l' ;
  22284. si (itron ega 1) ;
  22285. pp2 = pp1 plus ((xt0*lj) (yt0*lj) (zt0*lj)) ;
  22286. vdir = (xt0*lj) (yt0*lj) (zt0*lj) ;
  22287. sinon ;
  22288. xt yt1 zt1 = coor t ;
  22289. xpp2 ypp2 zpp2 = coor pp2 ;
  22290. pp1 = xpp2 ypp2 zpp2 ;
  22291. xg = xt*lj ;
  22292. yg = yt1*lj ;
  22293. zg = zt1*lj ;
  22294. pp2 = pp1 plus (xg yg zg) ;
  22295. vdir = xg yg zg ;
  22296. finsi ;
  22297. surf1 = d1 tran nele vdir ;
  22298. d1 = d1 plus vdir ;
  22299. surf2 = d2 tran nele vdir ;
  22300. d2 = d2 plus vdir ;
  22301. surf3 = d3 tran nele vdir ;
  22302. d3 = d3 plus vdir ;
  22303. surf4 = d4 tran nele vdir ;
  22304. d4 = d4 plus vdir ;
  22305. surfboj = surf1 et surf2 et surf3 et surf4 ;
  22306. *
  22307. * conservation des points definissant le troncon rectiligne
  22308. *
  22309. troncj.'pp1' = pp1 ;
  22310. troncj.'pp2' = pp2 ;
  22311. troncj.'pp3' = cbob ;
  22312. sinon ;
  22313. si ( (existe troncj 'r') et (existe troncj 'alpha') et (non (existe troncj 'l')) ) ;
  22314. mess ' ****** troncon no' itron 'courbe' ;
  22315. rj = troncj.'r' ;
  22316. alphaj = troncj.'alpha' ;
  22317. si (itron ega 1) ;
  22318. si (dbob > 0.) ;
  22319. crj = cbob plus (0. (dbob - rj) 0.) ;
  22320. sinon ;
  22321. crj = cbob plus (0. (dbob + rj) 0.) ;
  22322. finsi ;
  22323. sinon ;
  22324. xpp2 ypp2 zpp2 = coor pp2 ;
  22325. pp1 = xpp2 ypp2 zpp2 ;
  22326. xt yt1 zt1 = coor t ;
  22327. * vecteur norme vr perpendiculaire a vnor et t
  22328. si (alphaj > 0.) ;
  22329. vr = vnor pvec t ;
  22330. sinon ;
  22331. vr = t pvec vnor ;
  22332. finsi ;
  22333. xvr yvr zvr = coor vr ;
  22334. xcrj = xpp2 + ((rj+(b/2.))*xvr) ;
  22335. ycrj = ypp2 + ((rj+(b/2.))*yvr) ;
  22336. zcrj = zpp2 + ((rj+(b/2.))*zvr) ;
  22337. crj = xcrj ycrj zcrj ;
  22338. finsi ;
  22339. cvn = crj plus (vn1 vn2 vn3) ;
  22340. surf1 = d1 rota nele alphaj crj cvn ;
  22341. d1 = d1 tour alphaj crj cvn ;
  22342. surf2 = d2 rota nele alphaj crj cvn ;
  22343. d2 = d2 tour alphaj crj cvn ;
  22344. surf3 = d3 rota nele alphaj crj cvn ;
  22345. d3 = d3 tour alphaj crj cvn ;
  22346. surf4 = d4 rota nele alphaj crj cvn ;
  22347. d4 = d4 tour alphaj crj cvn ;
  22348. surfboj = surf1 et surf2 et surf3 et surf4 ;
  22349. *
  22350. * barycentre de la section finale
  22351. *
  22352. pp2 = pp1 tour alphaj crj cvn ;
  22353. * conservation du point definissant le centre du troncon courbe
  22354. troncj.'crj' = crj ;
  22355. *
  22356. * construction du nouveau vecteur tangent t (par rotation de alphaj)
  22357. *
  22358. t = t tour alphaj o1 ovn ;
  22359. troncj.'pp1' = pp1 ;
  22360. troncj.'pp2' = pp2 ;
  22361. sinon ;
  22362. mess ' erreur : troncon mal defini ' ;
  22363. quitter proc ;
  22364. finsi ;
  22365. finsi ;
  22366. troncj.'mail' = surfboj ;
  22367. si (itron ega 1) ;
  22368. demisurf = surfboj ;
  22369. sinon ;
  22370. demisurf = demisurf et surfboj ;
  22371. finsi ;
  22372. troncon.itron = troncj ;
  22373. itron = itron + 1 ;
  22374. fin btron ;
  22375. cont2 = d1 et d2 et d3 et d4 ;
  22376. elim 1.E-3 cont2 ;
  22377. *---------------------------------------------------------
  22378. * construction des troncons inferieurs par symetrie / xOy
  22379. *---------------------------------------------------------
  22380. si (ega isym 0);
  22381. itron = 1 ;
  22382. repeter btron2 ntron ;
  22383. troncj = troncon.itron ;
  22384. itron2 = (2*ntron) - itron + 1 ;
  22385. troncj2 = table ;
  22386. troncj2.'mail' = (troncj.'mail') syme plan o1 cbob cvn ;
  22387. si ( (existe troncj 'r') et (existe troncj 'alpha') et (non (existe troncj 'l')) ) ;
  22388. crj = (troncj.'crj') syme plan cbob p1 p2 ;
  22389. pp1 = (troncj.'pp2') syme plan cbob p1 p2 ;
  22390. pp2 = (troncj.'pp1') syme plan cbob p1 p2 ;
  22391. troncj2.'crj' = crj ;
  22392. troncj2.'pp1' = pp1 ;
  22393. troncj2.'pp2' = pp2 ;
  22394. troncj2.'r' = troncj.'r' ;
  22395. troncj2.'alpha' = troncj.'alpha' ;
  22396. finsi ;
  22397. si ( (existe troncj 'l') et (non (existe troncj 'r')) et (non (existe troncj 'alpha')) ) ;
  22398. pp1 = (troncj.'pp2') syme plan cbob p1 p2 ;
  22399. pp2 = (troncj.'pp1') syme plan cbob p1 p2 ;
  22400. troncj2.'pp1' = pp1 ;
  22401. troncj2.'pp2' = pp2 ;
  22402. troncj2.'pp3' = cbob ;
  22403. troncj2.'l' = troncj.'l' ;
  22404. finsi ;
  22405. troncon.itron2 = troncj2 ;
  22406. itron = itron + 1 ;
  22407. fin btron2 ;
  22408. finsi ;
  22409. finsi ;
  22410. *----------------------------------------------------------------------
  22411. * construction du symetrique du maillage de la bobine par rapport a xOy
  22412. *----------------------------------------------------------------------
  22413. surfbob = demisurf et (demisurf syme plan cbob p1 p2 ) ;
  22414. elim eps surfbob ;
  22415. mess 'construction de la premiere bobine effectuee' ;
  22416. *-----------------------------------------------------------
  22417. * construction des autres bobines par rotation autour de Oz
  22418. *-----------------------------------------------------------
  22419. ibob = 1 ;
  22420. tabmai.ibob = surfbob ;
  22421. surftot = surfbob ;
  22422. si (nbob > 1) ;
  22423. repeter bbob (nbob-1) ;
  22424. ibob = ibob + 1 ;
  22425. angln = (ibob-1)*360./nbob ;
  22426. surfbobn = surfbob tour angln o1 o2 ;
  22427. tabmai.ibob = surfbobn ;
  22428. surftot = surftot et tabmai.ibob ;
  22429. mess 'construction de la bobine' ibob 'effectuee' ;
  22430. fin bbob ;
  22431. finsi ;
  22432. *
  22433. * construction des axes
  22434. *
  22435. x1 = (2.*rt) 0. 0. ;
  22436. y1 = 0. (2.*rt) 0. ;
  22437. z1 = 0. 0. (2.*rt) ;
  22438. axes = (o1 d 1 x1) et (o1 d 1 y1) et (o1 d 1 z1) ;
  22439. axes = axes coul rouge ;
  22440. si (ega tabob.trac1 'oui') ;
  22441. trac oeil cach (surftot et axes) ;
  22442. finsi ;
  22443. fin proc ;
  22444. ****************************************
  22445. * calcul des champs de biot et savart *
  22446. ****************************************
  22447. tabchb = table ;
  22448. tab2.cont = table ;
  22449. re = ri + b ;
  22450. igeo1 = 0 ;
  22451. si (ega tabob.cbiot 'oui') ;
  22452. repeter bogeo1 ngeo ;
  22453. igeo1 = igeo1 + 1 ;
  22454. mess ' *** Domaine de calcul du champ numero' igeo1 ;
  22455. si (itest.igeo1 > -1) ;
  22456. tabcon = table ;
  22457. finsi ;
  22458. si (existe tageo1 igeo1) ;
  22459. geo1 = (tageo1.igeo1).'mail' ;
  22460. chp0 = manu chpo geo1 3 bx 0. by 0. bz 0. ;
  22461. ibob = 0 ;
  22462. repeter bbob2 nbob ;
  22463. ibob = ibob + 1 ;
  22464. si (existe tabsol ibob) ;
  22465. sol = tabsol.ibob ;
  22466. dens = sol/(b*h) ;
  22467. finsi ;
  22468. si (ega typbob 'c') ;
  22469. mess ' *** BIOT ; induction magnetique cree par ' 'la bobine circulaire numero' ibob ;
  22470. mess 'dont la solenation est' sol ;
  22471. sauter 1 ligne ;
  22472. si (ega ibob 1) ;
  22473. chb1 = biot geo1 cerc cbob pp1 pp2 ri re h dens mu0 ;
  22474. sinon ;
  22475. anglj = 360./nbob ;
  22476. cbob = cbob tour anglj o1 o2 ;
  22477. pp1 = pp1 tour anglj o1 o2 ;
  22478. pp2 = pp2 tour anglj o1 o2 ;
  22479. chb1 = chb1 et (biot geo1 cerc cbob pp1 pp2 ri re h dens mu0) ;
  22480. finsi ;
  22481. sinon ;
  22482. sauter 1 ligne ;
  22483. mess ' *** BIOT ; induction magnetique cree par ' 'la bobine en D numero' ibob ;
  22484. mess 'dont la solenation est' sol ;
  22485. sauter 1 ligne ;
  22486. itron = 0 ;
  22487. ntron = dime troncon ;
  22488. repeter bbob3 ntron ;
  22489. itron = itron + 1 ;
  22490. troncj = troncon.itron ;
  22491. *
  22492. * troncon courbe
  22493. *
  22494. si ( (existe troncj 'r') et (existe troncj 'alpha') ) ;
  22495. * mess ' troncon numero' itron;
  22496. ri = troncj.'r' ;
  22497. re = ri + b ;
  22498. crj = troncj.'crj' ;
  22499. pp1 = troncj.'pp1' ;
  22500. pp2 = troncj.'pp2' ;
  22501. * mess '** ri' ri ;
  22502. * list crj ;
  22503. * list pp1 ;
  22504. * list pp2 ;
  22505. si ( (ega ibob 1) et (ega itron 1) ) ;
  22506. mess ' *** premier troncon courbe ' ;
  22507. chb1 = biot geo1 arc crj pp1 pp2 ri re h dens mu0 ;
  22508. sinon ;
  22509. mess ' *** troncon courbe numero' itron;
  22510. si (ibob > 1) ;
  22511. teta = (ibob - 1)*360./nbob ;
  22512. tcrj = crj tour teta o1 o2 ;
  22513. tpp1 = pp1 tour teta o1 o2 ;
  22514. tpp2 = pp2 tour teta o1 o2 ;
  22515. chb1j = biot geo1 arc tcrj tpp1 tpp2 ri re h dens mu0 ;
  22516. chb1 = chb1 et chb1j ;
  22517. sinon ;
  22518. chb1j = biot geo1 arc crj pp1 pp2 ri re h dens mu0 ;
  22519. chb1 = chb1 et chb1j ;
  22520. finsi ;
  22521. finsi ;
  22522. finsi ;
  22523. *
  22524. * troncon rectiligne
  22525. *
  22526. si (existe troncj 'l') ;
  22527. * mess ' troncon numero' itron;
  22528. pp1 = troncj.'pp1' ;
  22529. pp2 = troncj.'pp2' ;
  22530. pp3 = troncj.'pp3' ;
  22531. * list pp1 ;
  22532. * list pp2 ;
  22533. * list pp3 ;
  22534. si ((ega ibob 1) et (ega itron 1));
  22535. mess ' *** premier troncon rectiligne' ;
  22536. chb1 = biot geo1 barr pp1 pp2 pp3 b h dens mu0 ;
  22537. sinon ;
  22538. mess ' *** troncon rectiligne numero' itron;
  22539. si (ibob > 1) ;
  22540. teta = (ibob - 1)*360./nbob ;
  22541. tpp1 = pp1 tour teta o1 o2 ;
  22542. tpp2 = pp2 tour teta o1 o2 ;
  22543. tpp3 = pp3 tour teta o1 o2 ;
  22544. chb1j = biot geo1 barr tpp1 tpp2 tpp3 b h dens mu0 ;
  22545. chb1 = chb1 et chb1j ;
  22546. sinon ;
  22547. chb1j = biot geo1 barr pp1 pp2 pp3 b h dens mu0 ;
  22548. chb1 = chb1 et chb1j ;
  22549. finsi ;
  22550. finsi ;
  22551. finsi ;
  22552. si (ega isym 1) ;
  22553. mess ' ***** calcul du champ par symetrie / xOy ' ;
  22554. si ( (ega ibob 1) et (ega itron 1) ) ;
  22555. chb1x = exco 'BX' chb1 'BX' ;
  22556. chb1y = exco 'BY' chb1 'BY' ;
  22557. chb1z = exco 'BZ' chb1 'BZ' ;
  22558. chb2z = chb1z*(-1.) ;
  22559. chb2 = chb1x et chb1y et chb2z ;
  22560. chb1 = chb1 et chb2 ;
  22561. sinon ;
  22562. chb1x = exco 'BX' chb1j 'BX' ;
  22563. chb1y = exco 'BY' chb1j 'BY' ;
  22564. chb1z = exco 'BZ' chb1j 'BZ' ;
  22565. chb2z = chb1z*(-1.) ;
  22566. chb2 = chb1x et chb1y et chb2z ;
  22567. chb1 = chb1 et chb2 ;
  22568. finsi ;
  22569. finsi ;
  22570. fin bbob3 ;
  22571. finsi ;
  22572. fin bbob2 ;
  22573. tabchb.igeo1 = chb1 ;
  22574. *----------------------------------------------------
  22575. * calcul des intersections pour le plan igeo1
  22576. *----------------------------------------------------
  22577. si (ega itest.igeo1 0) ;
  22578. tabcon.1 = cont1 et cont2 ;
  22579. finsi ;
  22580. si (ega itest.igeo1 1) ;
  22581. *----------------------------------------------------------------
  22582. * calcul analytique de l'intersection d'une bobine circulaire
  22583. * verticale avec un plan
  22584. *----------------------------------------------------------------
  22585. mess ' **** calcul analytique dans le cas' 'de la bobine circulaire' ;
  22586. sauter 1 ligne ;
  22587. zp = (tageo1.igeo1).'ZP' ;
  22588. mess ' **** plan a la cote' zp ;
  22589. x1 = h/2.;
  22590. cbob*point = tcara.4 ;
  22591. cxn = cbob plus (1. 0. 0.) ;
  22592. czn = cbob plus (0. 0. 1.) ;
  22593. si (zp < ri) ;
  22594. cos1 = ((ri**2.) - (zp**2.) )**0.5 ;
  22595. beta1 = atg zp cos1 ;
  22596. y1 = ri*(cos beta1) ;
  22597. pc1 = cbob plus (x1 y1 zp) ;
  22598. pc2 = cbob plus ( (0. - x1) y1 zp ) ;
  22599. *
  22600. cos2 = ((re**2.) - (zp**2.) )**0.5 ;
  22601. beta2 = atg zp cos2 ;
  22602. y2 = re*(cos beta2) ;
  22603. pc3 = cbob plus (x1 y2 zp) ;
  22604. pc4 = cbob plus ( (0. - x1) y2 zp ) ;
  22605. *
  22606. cont1 = pc1 d 1 pc2 d 1 pc4 d 1 pc3 d 1 pc1 ;
  22607. tabcon.1 = cont1 et (cont1 syme plan cbob cxn czn) ;
  22608. sinon ;
  22609. si (zp < re) ;
  22610. cos2 = ((re**2.)- (zp**2.) )**0.5 ;
  22611. beta2 = atg zp cos2 ;
  22612. y2 = re*(cos beta2) ;
  22613. pc1 = cbob plus (x1 y2 zp) ;
  22614. pc2 = cbob plus ( (0. - x1) y2 zp ) ;
  22615. pc3 = pc2 syme plan cbob cxn czn ;
  22616. pc4 = pc1 syme plan cbob cxn czn ;
  22617. cont1 = pc1 d 1 pc2 d 1 pc3 d 1 pc4 d 1 pc1 ;
  22618. tabcon.1 = cont1 ;
  22619. sinon ;
  22620. mess ' ***** le plan ne coupe pas les bobines !!' ;
  22621. finsi ;
  22622. finsi ;
  22623. si (non (ega vn2 0.)) ;
  22624. gama1 = atg vn2 vn1 ;
  22625. tabcon.1 = tabcon.1 tour gama1 cbob czn ;
  22626. finsi ;
  22627. finsi ;
  22628. si (ega itest.igeo1 2) ;
  22629. * mess 'Algorithme Denis Robert' ;
  22630. *------------------------------------------------------------------
  22631. * Algorithme de recherche des contours des bobines
  22632. *------------------------------------------------------------------
  22633. repeter bouci 1 ;
  22634. 'SAUTER' 1 'LIGNE' ;
  22635. 'MESS' 'Contour des bobines dans le domaine' igeo1 ;
  22636. 'MESS' '-------------------------------------------' ;
  22637. TABLIG = TABLE ;
  22638. TAB2.LIG = TABLIG ;
  22639. COUP1 = tageo1.igeo1 ;
  22640. IRECUP = 0 ;
  22641. 'SI' ( 'EXISTE' COUP1 'PP' ) ;
  22642. PP*'POINT' = COUP1.'PP' ;
  22643. 'SINON' ;
  22644. 'SAUTER' 1 'LIGNE' ;
  22645. 'MESS' 'Erreur : il manque PP pour le plan ' igeo1 ;
  22646. 'SAUTER' 1 'LIGNE' ;
  22647. IERR = 1 ; 'QUITTER' BOUCI;
  22648. 'FINSI' ;
  22649. 'SI' ( 'EXISTE' COUP1 'VP' ) ;
  22650. VP*'POINT' = COUP1.'VP' ;
  22651. 'SINON' ;
  22652. 'SAUTER' 1 'LIGNE' ;
  22653. 'MESS' 'Erreur : il manque VP pour le plan ' igeo1 ;
  22654. 'SAUTER' 1 'LIGNE' ;
  22655. IERR = 1 ; 'QUITTER' BOUCI ;
  22656. 'FINSI' ;
  22657. *
  22658. * Trois points vont definir ce plan : PP PP2 et PP3
  22659. *
  22660. PP11 PP12 PP13 = COORD PP ;
  22661. VP1 VP2 VP3 = COORD VP ;
  22662. *
  22663. * Vecteur WN tq : VP1 WN1 + VP2 WN2 + VP3 WN3 = 0
  22664. *
  22665. VPN1 = ( (VP1**2) + (VP2**2) + (VP3**2) ) ** 0.5 ;
  22666. 'SI' ( VPN1 'EGA' 0. ) ;
  22667. 'SAUTER' 1 'LIGNE' ;
  22668. 'MESS' 'ERREUR : plan ' igeo1 ' le vecteur VP est nul' ;
  22669. 'SAUTER' 1 'LIGNE' ;
  22670. IERR = 1 ; 'QUITTER' BOUCI ;
  22671. 'FINSI' ;
  22672. VN1 = VP1 / VPN1 ; VN2 = VP2 / VPN1 ; VN3 = VP3 / VPN1 ;
  22673. VPN = VN1 VN2 VN3 ;
  22674. 'SI' ( VN1 'NEG' 0. ) ;
  22675. 'SI' ( VN2 'NEG' 0. ) ;
  22676. 'SI' ( VN3 'NEG' 0. ) ;
  22677. W2 = VN3 / VN2 ; W3 = -1 ;
  22678. WN = ( (W2**2) + (W3**2) ) ** 0.5 ;
  22679. WN1 = 0. ; WN2 = W2 / WN ; WN3 = W3 / WN ;
  22680. 'SINON' ;
  22681. WN1 = 0. ; WN2 = 0. ; WN3 = 1. ;
  22682. 'FINSI' ;
  22683. 'SINON' ;
  22684. 'SI' ( VN3 'NEG' 0. ) ;
  22685. WN1 = 0. ; WN2 = 1. ; WN3 = 0. ;
  22686. 'SINON' ;
  22687. WN1 = 0. ; WN2 = 0. ; WN3 = 1. ;
  22688. 'FINSI' ;
  22689. 'FINSI' ;
  22690. 'SINON' ;
  22691. WN1 = 1. ; WN2 = 0. ; WN3 = 0. ;
  22692. 'FINSI' ;
  22693. *
  22694. XN1 = (VN2 * WN3) - (VN3 * WN2) ;
  22695. XN2 = (VN3 * WN1) - (VN1 * WN3) ;
  22696. XN3 = (VN1 * WN2) - (VN2 * WN1) ;
  22697. *
  22698. * WN et XN forment une base du plan de coupe
  22699. *
  22700. PP21 = PP11 + WN1 ; PP22 = PP12 + WN2 ;
  22701. PP23 = PP13 + WN3 ; PP31 = PP11 + XN1 ;
  22702. PP32 = PP12 + XN2 ; PP33 = PP13 + XN3 ;
  22703. PP2 = PP21 PP22 PP23 ; PP3 = PP31 PP32 PP33 ;
  22704. *
  22705. * Intersection de ce plan avec la bobine IBO
  22706. *
  22707. IINTER = 0 ;
  22708. *
  22709. * On traite separement chaque troncon
  22710. *
  22711. IINTEI = 0 ;
  22712. itron = 0 ;
  22713. si (ega typbob 'd') ;
  22714. ntron = dime tabob.'d' ;
  22715. sinon ;
  22716. ntron = 4 ;
  22717. finsi ;
  22718. 'REPETER' boutron ntron ;
  22719. itron = itron + 1 ;
  22720. si (ega typbob 'd') ;
  22721. MAI0 = (tabtron.itron).'mail' ;
  22722. sinon ;
  22723. MAI0 = tquart.itron ;
  22724. finsi ;
  22725. MAI1 = 'CHANGER' 'POI1' MAI0 ;
  22726. NBP1 = 'NBNO' MAI1 ;
  22727. 'MESS' '---> troncon de bobine : ' itron ;
  22728. 'MESS' '---> Nbre de pts : ' NBP1 ;
  22729. IP1 = 1 ;
  22730. IDESSOUS = 0 ; IDESSUS = 0 ; IDEDANS = 0 ;
  22731. DMOY = 0. ;
  22732. 'REPETER' BOUCPOI1 NBP1 ;
  22733. PO1 = MAI1 'POIN' IP1 ;
  22734. POX1 POY1 POZ1 = 'COORD' PO1 ;
  22735. MX1 = POX1 - PP11 ; MY1 = POY1 - PP12 ;
  22736. MZ1 = POZ1 - PP13 ; M1 = MX1 MY1 MZ1 ;
  22737. PDT1 = M1 'PSCAL' VPN ;
  22738. DMOY = DMOY + ('ABS' (PDT1)) ;
  22739. 'SI' ( ( 'ABS' PDT1 ) < 0.001 ) ;
  22740. IDEDANS = IDEDANS + 1 ;
  22741. 'FINSI' ;
  22742. 'SI' ( PDT1 '&lt;EG' -0.001 ) ;
  22743. IDESSOUS = IDESSOUS + 1 ;
  22744. 'FINSI' ;
  22745. 'SI' ( PDT1 '>EG' 0.001 ) ;
  22746. IDESSUS = IDESSUS + 1 ;
  22747. 'FINSI' ;
  22748. 'SI' ( IP1 'EGA' 1 ) ;
  22749. LISPDT = 'PROG' PDT1 ;
  22750. 'SINON' ;
  22751. LISPDT = LISPDT 'ET' ( 'PROG' PDT1 ) ;
  22752. 'FINSI' ;
  22753. IP1 = IP1 + 1 ;
  22754. 'FIN' BOUCPOI1 ;
  22755. *+*
  22756. *+* Distance de selection des points a projeter
  22757. *+* on divise DMOY par 2 si NELE = 4
  22758. *+* 3 8
  22759. COEF1 = 2. ;
  22760. DMOY = DMOY / NBP1 ;
  22761. DCRIT = DMOY / COEF1 ;
  22762. *
  22763. * tests sur la repartition des points / plan de coupe
  22764. *
  22765. 'SI' ( IDEDANS '>EG' 4 ) ;
  22766. ICAS = 1 ;
  22767. 'SINON' ;
  22768. 'SI' ( IDESSUS > IDESSOUS ) ;
  22769. ICAS = 2 ;
  22770. 'SINON' ;
  22771. ICAS = 3 ;
  22772. 'FINSI' ;
  22773. 'FINSI' ;
  22774. *
  22775. 'SI' ((( IDESSOUS '>EG' 1 ) 'ET' ( IDESSUS '>EG' 1 )) 'OU' ( IDEDANS '>EG' 1 )) ;
  22776. IINTER = IINTER + 1 ;
  22777. IINTEI = IINTEI + 1 ;
  22778. 'MESS' 'Il y a une intersection ...' ;
  22779. *
  22780. * On ne retient que les points les plus proches du
  22781. * plan de coupe Pc
  22782. *
  22783. IREC = 0 ;
  22784. 'REPETER' BOUCREC 7 ;
  22785. IREC = IREC + 1 ;
  22786. IP2 = 1 ; IOK = 0 ;
  22787. 'REPETER' BOUCTRI NBP1 ;
  22788. VAL1 = 'EXTRAIRE' LISPDT IP2 ;
  22789. 'SI' ( ( ICAS 'EGA' 1 ) et (('ABS' VAL1 ) '&lt;EG' 0.001) );
  22790. IOK = IOK + 1 ;
  22791. 'SI' ( IOK 'EGA' 1 ) ;
  22792. MAI2 = MAI1 'POIN' IP2 ;
  22793. 'SINON' ;
  22794. MAI2 = MAI2 'ET' ( MAI1 'POIN' IP2 ) ;
  22795. 'FINSI' ;
  22796. 'FINSI ' ;
  22797. 'SI' ( ( ICAS 'EGA' 2 ) et ((('ABS' VAL1 ) '&lt;EG' DCRIT ) 'ET' ( VAL1 '>EG' 0.001)) );
  22798. IOK = IOK + 1 ;
  22799. 'SI' ( IOK 'EGA' 1 ) ;
  22800. MAI2 = MAI1 'POIN' IP2 ;
  22801. 'SINON' ;
  22802. MAI2 = MAI2 'ET' ( MAI1 'POIN' IP2 ) ;
  22803. 'FINSI' ;
  22804. 'FINSI' ;
  22805. 'SI' ( (ICAS 'EGA' 3 ) et ((('ABS' VAL1 ) '&lt;EG' DCRIT ) 'ET' (VAL1 < -0.001)) );
  22806. IOK = IOK + 1 ;
  22807. 'SI' ( IOK 'EGA' 1 ) ;
  22808. MAI2 = MAI1 'POIN' IP2 ;
  22809. 'SINON' ;
  22810. MAI2 = MAI2 'ET' ( MAI1 'POIN' IP2 ) ;
  22811. 'FINSI' ;
  22812. 'FINSI' ;
  22813. IP2 = IP2 + 1 ;
  22814. 'FIN' BOUCTRI ;
  22815. list iok ;
  22816. si (iok > 1) ;
  22817. NBP2 = 'NBNO' MAI2 ;
  22818. sinon ;
  22819. NBP2 = 1 ;
  22820. finsi ;
  22821. 'MESS' '---> Distance critique : ' DCRIT ;
  22822. 'MESS' '---> Nbre de points retenus : ' NBP2 ;
  22823. 'MESS' '---> iok : ' iok ;
  22824. 'SI' ( NBP2 < 4 ) ;
  22825. 'SI' ( IREC '&lt;EG' 6 ) ;
  22826. 'MESS' 'Pas assez de points selectionnes' ;
  22827. 'MESS' 'essai nouvelle distance critique' ;
  22828. DCRIT = DCRIT * 1.25 ;
  22829. 'SINON' ;
  22830. 'MESS' 'Mauvaise selection des points : ' ;
  22831. 'MESS' 'contour introuvable !' ;
  22832. IERR = 1 ; 'QUITTER' BOUCREC ;
  22833. 'FINSI' ;
  22834. 'SINON' ;
  22835. 'QUITTER' BOUCREC ;
  22836. 'FINSI' ;
  22837. 'FIN' BOUCREC ;
  22838. si (ega iok 1) ;
  22839. iterer boutron ;
  22840. mess ' *** Il y a un point selectionne ! ' ;
  22841. finsi ;
  22842. *
  22843. * Construction de LIGi
  22844. *
  22845. POIPROJ = MAI2 'PROJ' VP 'PLAN' PP PP2 PP3 ;
  22846. *
  22847. * recherche de WMIN, XWMIN et d'un point oppose
  22848. *
  22849. II1 = 1 ;
  22850. NBP1 = 'NBNO' POIPROJ ;
  22851. 'REPETER' BOUCP1 NBP1 ;
  22852. PE1 = POIPROJ 'POIN' II1 ;
  22853. PEX1 PEY1 PEZ1 = 'COORD' PE1 ;
  22854. VV1 = PEX1 - PP11 ;
  22855. VV2 = PEY1 - PP12 ;
  22856. VV3 = PEZ1 - PP13 ;
  22857. PEW1 = (VV1 * WN1) + (VV2 * WN2) + (VV3 * WN3) ;
  22858. PEX1 = (VV1 * XN1) + (VV2 * XN2) + (VV3 * XN3) ;
  22859. 'SI' ( II1 'EGA' 1 ) ;
  22860. LW = 'PROG' PEW1 ; LX = 'PROG' PEX1 ;
  22861. WMIN = PEW1 ; XWMIN = PEX1 ;
  22862. IIMIN = 1 ;
  22863. 'SINON' ;
  22864. LW = LW 'ET' ( 'PROG' PEW1 ) ;
  22865. LX = LX 'ET' ( 'PROG' PEX1 ) ;
  22866. 'SI' ( PEW1 < WMIN ) ;
  22867. WMIN = PEW1 ; XWMIN = PEX1 ;
  22868. IIMIN = II1 ;
  22869. 'FINSI' ;
  22870. 'FINSI' ;
  22871. II1 = II1 + 1 ;
  22872. 'FIN' BOUCP1 ;
  22873. *
  22874. II2 = 1 ; DIAG0 = 0. ;
  22875. 'REPETER' BOUCP2 NBP1 ;
  22876. LW1 = 'EXTRAIRE' LW II2 ;
  22877. LX1 = 'EXTRAIRE' LX II2 ;
  22878. DIAG1 = ( ((LW1 - WMIN) ** 2) + ((LX1 - XWMIN) ** 2) ) ** 0.5 ;
  22879. 'SI' ( DIAG1 > DIAG0 ) ;
  22880. DIAG0 = DIAG1 ;
  22881. IIMAX = II2 ;
  22882. 'FINSI' ;
  22883. II2 = II2 + 1 ;
  22884. 'FIN' BOUCP2 ;
  22885. PC1 = POIPROJ 'POIN' IIMIN ;
  22886. PCX1 PCY1 PCZ1 = 'COORD' PC1 ;
  22887. PC2 = POIPROJ 'POIN' IIMAX ;
  22888. PCX2 PCY2 PCZ2 = 'COORD' PC2 ;
  22889. *
  22890. * PQ = PC2 - PC1
  22891. *
  22892. PQX1 = PCX2 - PCX1;
  22893. PQY1 = PCY2 - PCY1;
  22894. PQZ1 = PCZ2 - PCZ1;
  22895. PQ = PQX1 PQY1 PQZ1 ;
  22896. *
  22897. * PN = PQ ^ VN
  22898. *
  22899. PNX1 = (PQY1 * VN3) - (PQZ1 * VN2) ;
  22900. PNY1 = (PQZ1 * VN1) - (PQX1 * VN3) ;
  22901. PNZ1 = (PQX1 * VN2) - (PQY1 * VN1) ;
  22902. PN = PNX1 PNY1 PNZ1 ;
  22903. *
  22904. * Recherche des deux autres points -> PC3 et PC4
  22905. *
  22906. II3 = 1 ;
  22907. PSCAMAX = 0. ; PSCAMIN = 0. ;
  22908. 'REPETER' BOUCP3 NBP1 ;
  22909. PE1 = POIPROJ 'POIN' II3 ;
  22910. PEX1 PEY1 PEZ1 = 'COORD' PE1 ;
  22911. VV1 = PEX1 - PCX1 ;
  22912. VV2 = PEY1 - PCY1 ;
  22913. VV3 = PEZ1 - PCZ1 ;
  22914. PSC1 = (VV1 * PNX1) + (VV2 * PNY1) + (VV3 * PNZ1) ;
  22915. 'SI' ( PSC1 > PSCAMAX ) ;
  22916. PSCAMAX = PSC1 ; IIMAX = II3 ;
  22917. 'FINSI' ;
  22918. 'SI' ( PSC1 < PSCAMIN ) ;
  22919. PSCAMIN = PSC1 ; IIMIN = II3 ;
  22920. 'FINSI' ;
  22921. II3 = II3 + 1 ;
  22922. 'FIN' BOUCP3 ;
  22923. PC3 = POIPROJ 'POIN' IIMAX ;
  22924. PC4 = POIPROJ 'POIN' IIMIN ;
  22925. L1 = 'DROITE' 1 PC1 PC3 ; L2 = 'DROITE' 1 PC3 PC2 ;
  22926. L3 = 'DROITE' 1 PC2 PC4 ; L4 = 'DROITE' 1 PC4 PC1 ;
  22927. LIG1 = L1 'ET' L2 'ET' L3 'ET' L4 ;
  22928. LIG1 = LIG1 'COUL' vert ;
  22929. mess ' ***** iinter =' iinter ;
  22930. 'SI' (IINTER 'EGA' 1) ;
  22931. LB = LIG1 ;
  22932. 'SINON' ;
  22933. LB = LB 'ET' LIG1 ;
  22934. 'FINSI' ;
  22935. 'SINON' ;
  22936. 'DETR' MAI1 ; 'DETR' LISPDT ;
  22937. 'FINSI' ;
  22938. * IMAI = IMAI + 1 ;
  22939. 'FIN' boutron ;
  22940. 'SI' ( IINTEI '>EG' 1 ) ;
  22941. 'MESS' 'Dans le plan' igeo1 ',' iintei 'contours ont ete crees' ;
  22942. sinon ;
  22943. mess ' **** il n y a pas d intersection dans le plan' igeo1 ;
  22944. 'FINSI' ;
  22945. 'FIN' BOUCI ;
  22946. *
  22947. * Archivage de l'intersection dans TAB2.LIG.j
  22948. *
  22949. 'SI' (( IINTER '>EG' 1 ) 'OU' ( IRECUP 'EGA' 1 )) ;
  22950. tabcon.1 = LB ;
  22951. 'FINSI' ;
  22952. sauter 1 ligne ;
  22953. mess ' ************ fin du calcul des intersections *******' ;
  22954. finsi ;
  22955. sinon ;
  22956. iterer bogeo1 ;
  22957. finsi ;
  22958. si (ega itest.igeo1 -2) ;
  22959. mess ' **** le plan de calcul choisi n est pas horizontal!!' ;
  22960. finsi ;
  22961. *-------------------------------------------------------------------------
  22962. *
  22963. * construction des contours des autres bobines par rotation autour de Oz
  22964. *
  22965. *-------------------------------------------------------------------------
  22966. si ((itest.igeo1) > -1) ;
  22967. si (existe tabcon 1) ;
  22968. si (nbob > 1) ;
  22969. ibob = 1 ;
  22970. contot = tabcon.ibob ;
  22971. repeter bbob2 (nbob-1) ;
  22972. ibob = ibob + 1 ;
  22973. angln = (ibob-1)*360./nbob ;
  22974. tabcon.ibob = tabcon.1 tour angln o1 o2 ;
  22975. contot = contot et tabcon.ibob ;
  22976. fin bbob2 ;
  22977. finsi ;
  22978. finsi ;
  22979. (tab2.cont).igeo1 = tabcon ;
  22980. sinon ;
  22981. (tab2.cont).igeo1 = 0 ;
  22982. finsi ;
  22983. fin bogeo1 ;
  22984. finsi ;
  22985. sauter 1 ligne ;
  22986. mess ' *** Fin normale de la procedure TORO ***' ;
  22987. sauter 1 ligne ;
  22988. finproc tabchb tab2 ;
  22989. **** TOTAL
  22990. ****************************************************
  22991. ****** PROCEDURE TOTAL ******
  22992. *-------------------------------------------------
  22993. DEBPROC TOTAL CH1*CHPOINT GEO*MAILLAGE COMP1*MOT ;
  22994. CH2 = REDU CH1 GEO ;
  22995. CHTOT = RESU CH2 ;
  22996. P1 = (EXTR CHTOT MAIL) POIN 1 ;
  22997. *MESS 'RESULTANTE DE LA COMPOSANTE ' COMP1 ;
  22998. TOT1 = EXTR CHTOT COMP1 P1 ;
  22999. *LIST TOT1 ;
  23000. FINPROC TOT1 ;
  23001. *-------------------------------------------------
  23002. **** @TPERM
  23003. 'DEBPROC' @TPERM TAB1*'TABLE ' ;
  23004. SI ( TAB1.PERMANENT ) ;
  23005.  
  23006. MESS '>>>>> 4.10 >>>>>>' ;
  23007.  
  23008. COTETF1 = TAB1.C_COTETF1 ;
  23009. SITETF1 = TAB1.C_SITETF1 ;
  23010. COTETR1 = TAB1.C_COTETR1 ;
  23011. SITETR1 = TAB1.C_SITETR1 ;
  23012. COTETC1 = TAB1.C_COTETC1 ;
  23013. SITETC1 = TAB1.C_SITETC1 ;
  23014. TAC2 = TABLE;
  23015. TAB1.I_FPAT1 = TABLE;
  23016. TAB1.FLUX_CRITIQUE = TABLE;
  23017. TAB1.EV_FLUX_CONV = TABLE;
  23018. TAB1.EV_FLUX_RAYO = TABLE;
  23019. TAB1.FLJB_CRI_TONG = TABLE;
  23020. TAB1.RESUTHER = TABLE;
  23021. TAB1.RESUTHER.COEFECHANGE = TABLE;
  23022. TAB1.RESUTHER.VALEUR_TETA = TABLE;
  23023. TAB1.RESUTHER.COEFRAYONNE = TABLE;
  23024. TAB1.RESUTHER.CONDUCMAT = TABLE;
  23025. *
  23026. *======== DEBUT BOUCLE : DIFFERENTES VALEURS DE FLUX INCIDENT
  23027. *
  23028. I_11 = 0;
  23029. REPETER BOCA ( DIME TAB1.LIS_FLUX );
  23030. I_11 = I_11 + 1;
  23031. TAB1.'ITER'= I_11;
  23032. *********** cas LAMBDAQ VPAT1 = exp*sinus
  23033. *********** cas LAMBDAQ SOM1 = somme ( exp*sinus)
  23034. *********** cas LAMBDAQ FACFM1 = SOM1 / largeur (v. moyenne du profil)
  23035. *********** cas LAMBDAQ FLU1 = FACFM1 * VFLUXIMPOSE ( =PHI0)
  23036. *********** cas LAMBDAQ VFPAT1 = exp*sinus*phi0
  23037. * SOM1 = somme de l'integrale de forme
  23038. * FACFM1 cette designation vient de FACTEUR de FORME 1
  23039. * ces valeurs proviennent de CFLUXX
  23040.  
  23041. SAUTER 1 LIGNE ;
  23042. MESS '---------------------------------------';
  23043. MESS ' Step number ' I_11 ' : Heat flux [MW/m2] ' ((EXTR TAB1.LIS_FLUX I_11)/1.E6);
  23044. MESS ' ' ;
  23045.  
  23046. * 'TRAC_GRAPHE' indice pour ne tracer les graphes qu'a l'iteration 1
  23047.  
  23048. SI (EGA I_11 1) ;
  23049. TAB1.'TRAC_GRAPHE' = VRAI ;
  23050. SINON ;
  23051. TAB1.'TRAC_GRAPHE' = FAUX ;
  23052. FINSI ;
  23053.  
  23054.  
  23055. FLU1 = EXTR TAB1.'LIS_FLUMOYEN' I_11;
  23056. PUI1 = EXTR TAB1.'LIS_PUI1' I_11;
  23057. TAB1.V_FLUMOY1 = EXTR TAB1.'LIS_FLUMOYEN' I_11;
  23058. *jsFLU1 = TAB1.'FLU1'.I_11;
  23059. *jsPUI1 = TAB1.'PUI1'.I_11;
  23060. *jsTAB1.V_FLUMOY1 = TAB1.'FLU1'.I_11;
  23061. VFPAT1 = TAB1.'VFPAT1'.I_11;
  23062. MESS '>@TPERM> LHEATED POWER' TAB1.L_HEATED PUI1;
  23063. @CALOR TAB1 PUI1 ;
  23064. *js 15/6/95T_LOCAL = TAB1.'T_LOCAL' ;
  23065. *
  23066. *--- CARACT. EAU A TMOY non a t_local
  23067. *
  23068. *--- AUTRE METHODE DE CALCUL DE H CONVECTION
  23069. *
  23070. SI ( NON ( EXISTE TAB1 PFIXTONB ) ) ;
  23071. TAB1 . PFIXTONB = FAUX ;
  23072. FINSI ;
  23073. *
  23074. *--- CALCUL DU COEFFICIENT D'ECHANGE
  23075. *
  23076. @CALHCON TAB1 ;
  23077. TAB1.'EV_FLUX_CONV'.I_11 = TAB1.EVOFT1 ;
  23078. *
  23079. *--- CALCUL DU FLUX CRITIQUE
  23080. *
  23081. @FLUCRIT TAB1 ;
  23082. TAB1.'FLUX_CRITIQUE'.I_11 = TAB1.L_QCHFW ;
  23083. *
  23084. *---- modif Jean BOSCARY 05 10 94
  23085. * faire apparaitre la vraie valeur de TONG75
  23086. * i.e. QCRI1 non multiplie par 1.67
  23087. SI ( NON ( EXISTE TAB1 M_TONGJB ) ) ;
  23088. TAB1.M_TONGJB = FAUX ;
  23089. FINSI ;
  23090. SI TAB1.M_TONGJB ;
  23091. QCRI2 HOU1 TOU1 DTSUB1 XOU1 = TONG75JB TAB1 ;
  23092. TAB1.'FLJB_CRI_TONG'.I_11 = QCRI2 ;
  23093. FINSI ;
  23094. *
  23095. *
  23096. *--- APPEL PROCEDURE CALCUL DE 'H RAYONNEMENT'
  23097. *
  23098. ERAYON1 = @CALHRAY TAB1 ;
  23099. TAB1.'EV_FLUX_RAYO'.I_11 = TAB1.EVORAYT1 ;
  23100. *
  23101. MESS ' MAXI MINI VALEURS CALCULEES DU FLUX RENTRANT ' ( MAXI VFPAT1 ) ( MINI VFPAT1 );
  23102. FPAT1 = FLUX (TAB1 . 'MODELF') VFPAT1 ;
  23103. @TRFLI VFPAT1 FPAT1 TAB1 ;
  23104. *--- INIT DES TABLES
  23105. *---(DONNEES A ENVOYER DANS PROCEDUR TRANSIT1)
  23106. *
  23107. SI ( EXISTE TAB1 TEMPERATURE ) ;
  23108. MENAGE ;
  23109. FINSI ;
  23110. SI ( TAB1.OLD ) ;
  23111. TAB1.'SOUSTYPE' = THERMIQUE ;
  23112. SI ( EXISTE TAB1 LFLUX_CONV ) ;
  23113. TAB1.'MAILLAGV' = TAB1.LFLUX_CONV ;
  23114. TAB1.'CONVECTION' = IPOL TAB1.'T_LOCAL' ( EXTR TAB1.ECONVEC1 'TEMPERATURE' ) ( EXTR TAB1.ECONVEC1 'CONVECTION' ) ;
  23115. TAB1.'EVOCONV' = TAB1.ECONVEC1 ;
  23116. FINSI ;
  23117. SI ( EXISTE TAB1 LFLUX_RAYO ) ;
  23118. TAB1.'MAILLAGR' = TAB1.LFLUX_RAYO ;
  23119. TAB1.'HRAYONNE' = IPOL (TAB1.TEMP_RAYO) ( EXTR ERAYON1 'TEMPERATURE' ) ( EXTR ERAYON1 'COEFFICIENT ECHANGE' ) ;
  23120. TAB1.'TETR' = TAB1.TEMP_RAYO ;
  23121. TAB1.'EVOCONR' = ERAYON1 ;
  23122. FINSI ;
  23123. FPAT2 = FPAT1 ;
  23124. SI ( EXISTE TAB1 V_SOURCE ) ;
  23125. FPAT2 = FPAT1 ET TAB1.'FSOU1' ;
  23126. FINSI ;
  23127. FPAT3 = FPAT2 ;
  23128. SI ( EXISTE TAB1 'FLUX_IMP' ) ;
  23129. FPAT3 = FPAT2 ET TAB1.'FLUX_IMP' ;
  23130. FINSI ;
  23131. TAB1.'FLUX' = FPAT3 ;
  23132.  
  23133. * TEMPS ;
  23134. *
  23135. *--- APPEL PROCED. TRANSIT1
  23136. *--- RESOL PB THERMIQUE NONLIN
  23137. *
  23138. TAB1.'TETA' = TAB1.'T_LOCAL';
  23139. @TRANS10 TAB1;
  23140. TAB1.I_11 = TAB1.TEMPERATURE;
  23141. TAB1.I_FPAT1.I_11 = FPAT1;
  23142. TAB1.RESUTHER.COEFECHANGE.I_11 = TAB1.COEFECHANGE;
  23143. TAB1.RESUTHER.VALEUR_TETA.I_11 = TAB1.VALEUR_TETA;
  23144. TAB1.RESUTHER.COEFRAYONNE.I_11 = TAB1.COEFRAYONNE;
  23145. TAB1.RESUTHER.CONDUCMAT.I_11 = TAB1.CONDUCMAT;
  23146. SINON;
  23147. TAB1.'SOUSTYPE' = THERMIQUE ;
  23148. SI( NON (EXISTE TAB1 TEMPERATURE) );
  23149. TAB1.'INSTANT(0)' = MANU CHPO STOT1 1 'T' TAB1.'T_LOCAL';
  23150. SINON;
  23151. TAB1.'INSTANT(0)' = TAB1.TEMPERATURE;
  23152. FINSI;
  23153. TAB1.CONVECTION = TABLE;
  23154. TAB1.CONVECTION.TABCONV1 = TABLE;
  23155. TAB1.CONVECTION.TABTE1 = TABLE;
  23156. MCONV1 = MODE TAB1.LFLUX_CONV thermique CONVECTION;
  23157. MCONV2 = MODE TAB1.LFLUX_RAYO thermique CONVECTION;
  23158. TAB1.CONVECTION.TABCONV1.MCONV1 = TAB1.ECONV ;
  23159. TAB1.CONVECTION.TABTE1.MCONV1 = TAB1.'T_LOCAL' ;
  23160. TAB1.CONVECTION.TABCONV1.MCONV2 = ERAYON1 ;
  23161. TAB1.CONVECTION.TABTE1.MCONV2 = TAB1.'TEMP_RAYO' ;
  23162. FPAT2 = FPAT1 ;
  23163. SI ( EXISTE TAB1 V_SOURCE ) ;
  23164. FPAT2 = FPAT1 ET TAB1.'FSOU1' ;
  23165. FINSI ;
  23166. TAB1.'FLUX' = FPAT2 ;
  23167. TEMPS;
  23168. TRANSIT1 TAB1;
  23169. TEMPS;
  23170. TAB1.RESUTHER.COEFECHANGE.I_11 = TAB1.COEFECHANGE.MCONV1 ;
  23171. TAB1.RESUTHER.VALEUR_TETA.I_11 = TAB1.CONVECTION.TABTE1.MCONV1;
  23172. * TAB1.RESUTHER.VALEUR_TETA.I_11 = TAB1.VALEUR_TETA.MCONV1 ;
  23173. TAB1.RESUTHER.COEFRAYONNE.I_11 = TAB1.COEFECHANGE.MCONV2;
  23174. TAB1.RESUTHER.CONDUCMAT.I_11 = TAB1.CONDUCMAT ;
  23175.  
  23176. FINSI;
  23177. FIN BOCA;
  23178. FINSI;
  23179. *
  23180. *
  23181. * FIN DU PERMANENT
  23182. *
  23183. FINPROC ;
  23184. *
  23185. *----------Fin de la procedure @TPERM
  23186. *--------------------------------------------------------------------
  23187.  
  23188. **** @TRASCH
  23189. DEBPROC @TRASCH M1/MOT OE1/POINT MO1*MMODEL CHA1*MCHAML MA1*MAILLAGE MA2*MAILLAGE CT1*MAILLAGE ;
  23190.  
  23191. *
  23192. * !!! R. MITTEAU !!! attention, procedure standard
  23193. *
  23194. * un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
  23195. * pour les mises a jour
  23196. *
  23197.  
  23198. CHA2 = REDU CHA1 MO1 ;
  23199. CH1 = CHAN CHPO MO1 CHA2 ;
  23200. * CH2 = CHAN 'ATTRIBUT' CH1 'NATURE' 'DISCRET' ;
  23201. CHA2 = REDU CHA1 MO1 ;
  23202. CO1 = EXTR (EXTR CH1 'COMP') 1 ;
  23203. V1 = ((MINI CH1) + (MAXI CH1)) * .5 ;
  23204. SI (EGA (NBEL MA1) (NBEL MA2));
  23205. CHT = CH1 ;
  23206. SINON ;
  23207. MAE = (CHAN POI1 MA1) DIFF (CHAN POI1 MA2) ;
  23208. CHE = MANU CHPO MAE 1 CO1 V1 ;
  23209. * CHE2 = CHAN 'ATTRIBUT' CHE 'NATURE' 'DISCRET' ;
  23210. CHT = @ET CH1 CHE ;
  23211. FINSI ;
  23212. SI (NON (EXISTE M1)) ;
  23213. M1 = TEXT ' ';
  23214. FINSI ;
  23215. SI (NON ( EXISTE OE1)) ;
  23216. OE1 = TEXT ' ' ;
  23217. FINSI ;
  23218. TRAC M1 OE1 CHT MA2 CT1 ;
  23219. FINPROC ;
  23220. **** @TRCPLAS
  23221. DEBPROC @TRCPLAS TAB1*TABLE MO_1*MMODEL I__1*ENTIER ;
  23222. MESS '---------------------------------> Entree dans @TRCPLAS ';
  23223. P_T1 = PROG 20. 100. 200. 300. 400. 500. 600. 700. 800. 900. ;
  23224. * P_T1 = PROG 20. 100. 200. 300. 400. 500. 600. ;
  23225. EPSB = 0.05 ;
  23226. I1_1 = 0 ;
  23227. TITRE TAB1.NOM_MAT.I__1 'CINEMATIC PLASTIFICATION CURVES' ;
  23228. T_AC1 = TABLE ;
  23229. LIS_1 = MOTS CROI TRIA PLUS LOSA CARR TRIB ETOI TRIB CARR LOSA;
  23230. REPETER BOCPLAS1 ( DIME P_T1 ) ;
  23231. I1_1 = I1_1 + 1 ;
  23232. T_1 = EXTRAIRE P_T1 I1_1 ;
  23233. EE_1 = @IPOE T_1 TAB1.'TETMAT'.MO_1.'YOUN' ;
  23234. YY_1 = @IPOE T_1 TAB1.'TETMAT'.MO_1.'SIGY' ;
  23235. HH_1 = @IPOE T_1 TAB1.'TETMAT'.MO_1.'H' ;
  23236. EPSY = YY_1 / EE_1 ;
  23237. S_B = YY_1 + ((EPSB - EPSY)* HH_1) ;
  23238. P_EPS1 = PROG 0. EPSY EPSB ;
  23239. P_SIG1 = PROG 0. YY_1 S_B ;
  23240. EV_1 = EVOL MANU '1EPSILON' P_EPS1 '1SIGMA' P_SIG1 ;
  23241. SI (EGA I1_1 1) ;
  23242. EV_PL1 = EV_1 ;
  23243. SINON ;
  23244. EV_PL1 = EV_PL1 ET EV_1 ;
  23245. FINSI ;
  23246. MARQ1 = EXTR I1_1 LIS_1 ;
  23247. T_AC1.I1_1 = 'CHAIN' ' MARQ ' MARQ1 ' TITR ' T_1 ;
  23248. FIN BOCPLAS1 ;
  23249. DESS EV_PL1 LEGE XBOR 0. 0.003 MIMA DATE T_AC1 ;
  23250. DESS EV_PL1 LEGE XBOR 0. 0.04 MIMA DATE T_AC1 ;
  23251. MESS '---------------------------------> Sortie de @TRCPLAS ';
  23252. FINPROC ;
  23253. **** @TRFLI
  23254. DEBPROC @TRFLI VFPAT1*CHPOINT FPAT1*CHPOINT TAB1*TABLE ;
  23255. *
  23256. ************************************************************************
  23257. * @TRFLI procedure de trace du flux incident 2D et 3D *
  23258. * VECFLUI vecteur representant le flux incident *
  23259. * VECFLUII vecteur representant le flux incident integre EF *
  23260. * Reecriture et rajout de la visu 3D : Alain MOAL (aout 1995) *
  23261. ************************************************************************
  23262. *
  23263. *------------------ VARIABLES D'ENTREE
  23264. COSDIR1 = TAB1.C_COTETF1 ;
  23265. COSDIR2 = TAB1.C_SITETF1 ;
  23266. COSDIR3 = TAB1.C_COS3F1 ;
  23267. IHYPVAP = TAB1.HYPERVAP ;
  23268. DH0 = TAB1.DH ;
  23269. MAXSOFL = TAB1.MAX_SOFL ;
  23270. DMAQ0 = TAB1.D_MAQUETTE ;
  23271. CONT0 = TAB1.'M_IL_CONTOUR' ;
  23272. ITRACFI = TAB1.L_TRAC_FLUXI ;
  23273. NIVEAU1 = TAB1.'NIVEAU' ;
  23274. SI (NIVEAU1 >EG 4) ;
  23275. MESS '-----------------------------------> calling @TRFLI ';
  23276. FINSI ;
  23277. SI (NIVEAU1 >EG 3) ;
  23278. MESS '> @TRFLI > IHYPVAP ';LIST IHYPVAP ;
  23279. MESS '> @TRFLI > DH0 ' DH0 ;
  23280. MESS '> @TRFLI > MAXSOFL ' MAXSOFL ;
  23281. MESS '> @TRFLI > DMAQ0 ' DMAQ0 ;
  23282. MESS '> @TRFLI > NIVEAU1 ' NIVEAU1 ;
  23283. TITR '> @TRFLI > CONT0' ; TRAC CONT0 NCLK ;
  23284. MESS '> @TRFLI > ITRACFI ';LIST ITRACFI ;
  23285. FINSI ;
  23286. SI (EGA (VALEUR DIME) 3) ;
  23287. LIG0 = TAB1.LFLUX_EXTE_DESS ;
  23288. OEIL0 = TAB1.VIEW_P ;
  23289. FINSI ;
  23290. *--------------------------------------
  23291. *
  23292. *---- facteurs d'amplification pour la visualisation des vecteurs
  23293.  
  23294. SI IHYPVAP ;
  23295. AMPLV1 = DH0 / (2. * MAXSOFL) ;
  23296. SINON ;
  23297. AMPLV1 = DMAQ0 / (2. * MAXSOFL) ;
  23298. FINSI ;
  23299. AMPLP1 = AMPLV1 * 1.E5 ;
  23300. *
  23301. *---- visualisations en 2D
  23302. *
  23303. SI (EGA (VALEUR DIME) 2) ;
  23304. * ---- CONT0 est une ligne
  23305. CHPX = EXCO SCAL (VFPAT1 * COSDIR1) UX ;
  23306. CHPY = EXCO SCAL (VFPAT1 * COSDIR2) UY ;
  23307. CHPT = @ET CHPX CHPY ;
  23308. VECFLUI = @VECADA CHPT (-1. * AMPLV1) 'ROUGE' ;
  23309. *
  23310. CHPX = EXCO Q (FPAT1 * COSDIR1) UX ;
  23311. CHPY = EXCO Q (FPAT1 * COSDIR2) UY ;
  23312. CHPT = @ET CHPX CHPY ;
  23313.  
  23314. VECFLUII = @VECADA CHPT (-1. * AMPLP1) 'ROUGE' ;
  23315. *
  23316. SI ITRACFI ;
  23317. TITRE ' @TRFLI : INCIDENT FLUX ' ;
  23318. TRAC VECFLUI CONT0 ;
  23319. TITRE ' @TRFLI : INTEGRATED FLUX ' ;
  23320. TRAC VECFLUII CONT0 ;
  23321. FINSI;
  23322. FINSI ;
  23323. *
  23324. *---- visualisations en 3D
  23325. *
  23326. SI (EGA (VALEUR DIME) 3) ;
  23327. * ---- CONT0 est une surface, LIG0 est une ligne
  23328. CHPX = EXCO SCAL (VFPAT1 * COSDIR1) UX ;
  23329. CHPY = EXCO SCAL (VFPAT1 * COSDIR2) UY ;
  23330. CHPZ = EXCO SCAL (VFPAT1 * COSDIR3) UZ ;
  23331. CHPT = @ET (@ET CHPX CHPY) CHPZ ;
  23332. VECFLUI = @VECADA CHPT (-1. * AMPLV1) 'ROUGE' ;
  23333. *
  23334. CHPX = EXCO Q (FPAT1 * COSDIR1) UX ;
  23335. CHPY = EXCO Q (FPAT1 * COSDIR2) UY ;
  23336. CHPZ = EXCO Q (FPAT1 * COSDIR3) UZ ;
  23337. CHPT = @ET (@ET CHPX CHPY) CHPZ ;
  23338. VECFLUII = @VECADA CHPT (-1. * AMPLP1) 'ROUGE' ;
  23339. *
  23340. SI ITRACFI ;
  23341. TITRE ' @TRFLI : INCIDENT FLUX ' ;
  23342. TRAC 'CACH' OEIL0 VECFLUI CONT0 ;
  23343. TITRE ' @TRFLI : INTEGRATED FLUX ' ;
  23344. TRAC 'CACH' OEIL0 VECFLUII CONT0 ;
  23345. FINSI;
  23346. *
  23347. * ---- Trace du flux incident le long d'une ligne
  23348. * ---- en fonction de l'abscisse curviligne
  23349. TITRE ' @TRFLI : INCIDENT FLUX' ;
  23350. FLUXI = NOMC SCAL VFPAT1 ;
  23351. DESSIN (EVOL JAUN CHPO FLUXI SCAL LIG0) MIMA ;
  23352. FINSI ;
  23353. *
  23354. *------------------ VARIABLES DE SORTIE
  23355. TAB1.V_VEC11 = VECFLUII ;
  23356. TAB1.V_VEC22 = VECFLUI ;
  23357. *--------------------------------------
  23358. *
  23359. SI (NIVEAU1 >EG 4) ;
  23360. MESS '-----------------------------------> exiting @TRFLI ';
  23361. FINSI ;
  23362. FINPROC ;
  23363.  
  23364. **** @TTRACG
  23365. debproc @ttracg poin1/point text1/texte text2/texte text3/texte geo1*maillage str1*maillage ;
  23366.  
  23367. v1 = vale dime ;
  23368.  
  23369. str2 = str1 coul blan ;
  23370. geo2 = geo1 coul roug ;
  23371.  
  23372. ld1 = (maxi (coor 1 geo1)) - (mini (coor 1 geo1)) ;
  23373. ld2 = (maxi (coor 2 geo1)) - (mini (coor 2 geo1)) ;
  23374. ld3 = (maxi (coor 3 geo1)) - (mini (coor 3 geo1)) ;
  23375.  
  23376. dcar1 = ((ld1 * ld1) + (ld2 * ld2) + (ld3 * ld3)) ** .5 ;
  23377. dcar2 = dcar1 / 10000. ;
  23378. dcar3 = dcar2 * (2.**.5) ;
  23379.  
  23380. * dcar1 est la dimension caracteristique de geo1
  23381.  
  23382.  
  23383. si (ega v1 2) ;
  23384. geo3 = geo2 plus (dcar2 dcar3) ;
  23385. sinon ;
  23386. geo3 = geo2 plus (dcar2 dcar3 0.);
  23387. finsi ;
  23388.  
  23389. *1texttit = chain geo1 'en rouge et ' geo2 'en blan' ;
  23390. *titr 1texttit
  23391.  
  23392.  
  23393. si (exis poin1) ;
  23394. poin2 = poin1;
  23395. sinon ;
  23396. poin2 = text ' ';
  23397. finsi ;
  23398.  
  23399. si (exis text3) ;
  23400. trac poin2 text1 text2 text3 (geo3 et str2) ;
  23401. sinon ;
  23402. si (exis text2 ) ;
  23403. trac poin2 text1 text2 (geo3 et str2);
  23404. sinon ;
  23405. si (exis text1 ) ;
  23406. trac poin2 text1 (geo3 et str2) ;
  23407. sinon ;
  23408. trac poin2 (str2 et geo3 );
  23409. finsi ;
  23410. finsi ;
  23411. finsi ;
  23412.  
  23413.  
  23414.  
  23415.  
  23416.  
  23417. finproc ;
  23418.  
  23419.  
  23420.  
  23421.  
  23422. **** @TTRACP
  23423. debproc @ttracp text1/text text2/text text3/text pp1*point geo1*maillage ;
  23424.  
  23425. v1 = vale dime ;
  23426.  
  23427. geo2 = geo1 coul bleu ;
  23428. ld1 = (maxi (coor 1 geo1)) - (mini (coor 1 geo1)) ;
  23429. ld2 = (maxi (coor 2 geo1)) - (mini (coor 2 geo1)) ;
  23430. ld3 = (maxi (coor 3 geo1)) - (mini (coor 3 geo1)) ;
  23431.  
  23432. dcar1 = ((ld1 * ld1) + (ld2 * ld2) + (ld3 * ld3)) ** .5 ;
  23433. dcar2 = dcar1 / 50. ;
  23434. dcar3 = -1. * dcar2 ;
  23435.  
  23436. * dcar1 est la dimension caracteristique de geo1
  23437.  
  23438.  
  23439. si (ega v1 2) ;
  23440. pp2 = pp1 plus (dcar2 dcar2);
  23441. pp3 = pp1 plus (dcar3 dcar3);
  23442. pp4 = pp1 plus (dcar2 dcar3);
  23443. pp5 = pp1 plus (dcar3 dcar2);
  23444. croix1 = (pp2 d 1 pp3) et (pp4 d 1 pp5);
  23445. sinon ;
  23446. pp2 = pp1 plus (dcar2 0. 0.);
  23447. pp3 = pp1 plus (dcar3 0. 0.);
  23448. pp4 = pp1 plus (0. dcar2 0.);
  23449. pp5 = pp1 plus (0. dcar3 0.);
  23450. pp6 = pp1 plus (0. 0. dcar2);
  23451. pp7 = pp1 plus (0. 0. dcar3);
  23452. croix1 = (pp2 d 1 pp3) et (pp4 d 1 pp5) et (pp6 d 1 pp7) ;
  23453. finsi ;
  23454.  
  23455. croix2 = croix1 coul roug ;
  23456.  
  23457.  
  23458. *1texttit = chain 'point ' pp1 'dans' geo1 ;
  23459. *titr 1texttit
  23460.  
  23461. si (exis text3) ;
  23462. trac text1 text2 text3 (geo2 et croix2) ;
  23463. sinon ;
  23464. si (exis text2 ) ;
  23465. trac text1 text2 (geo2 et croix2) ;
  23466. sinon ;
  23467. si (exis text1 ) ;
  23468. trac text1 (geo2 et croix2) ;
  23469. sinon ;
  23470. trac (geo2 et croix2) ;
  23471. finsi ;
  23472. finsi ;
  23473. finsi ;
  23474.  
  23475.  
  23476.  
  23477.  
  23478.  
  23479. finproc ;
  23480.  
  23481.  
  23482.  
  23483.  
  23484. **** @TTRANS
  23485. 'DEBPROC' @TTRANS TAB1*'TABLE ' ;
  23486. ** on regarde si il y a un transitoire
  23487. SI ( NON ( EXISTE TAB1 TRANSITOIRE )) ;
  23488. TAB1.TRANSITOIRE = FAUX ;
  23489. FINSI ;
  23490. *
  23491. SI ( TAB1.TRANSITOIRE ) ;
  23492. TAB1.ITER = DIME TAB1.LIS_FLUX;
  23493. TAB1.'TRAC_GRAPHE' = VRAI ;
  23494.  
  23495. *********** cas LAMBDAQ VPAT1 = exp*sinus
  23496. *********** cas LAMBDAQ SOM1 = somme ( exp*sinus)
  23497. *********** cas LAMBDAQ SOM3 = SOM1 * PHIZERO
  23498. *********** cas LAMBDAQ FACFM1 = SOM1 / largeur (v. moyenne du profil)
  23499. *********** cas LAMBDAQ FLU1 = FACFM1 * VFLUXIMPOSE
  23500. *********** cas LAMBDAQ VFPAT1 = exp*sinus*phi0
  23501. *********** cas LAMBDAQ FLU1 = FACFM1 * VFLUXIMPOSE
  23502. *********** cas LAMBDAQ PHIZERO = VFLUXIMPOSE
  23503.  
  23504. *js FLU1 = TAB1.'FLU1'.(DIME TAB1.LIS_FLUX);
  23505. *js PUI1 = TAB1.'PUI1'.(DIME TAB1.LIS_FLUX);
  23506. FLU1 = EXTR TAB1.'LIS_FLUMOYEN' 1;
  23507. PUI1 = EXTR TAB1.'LIS_PUI1' 1;
  23508.  
  23509. TAB1.V_FLUMOY1 = FLU1;
  23510.  
  23511. VFPAT1 = TAB1.'VFPAT1'.(DIME TAB1.LIS_FLUX);
  23512. FPAT1 = FLUX TAB1.'MODELF' VFPAT1;
  23513. * SOM2 = ( MAXI (RESU FPAT1)) ;
  23514. * MESS ' >>>>resu flux element finis ' SOM2 ;
  23515. * MESS ' >>>>valeur prevue ' TAB1.'V_SOM1';
  23516. * SI ( NON ( TAB1.'V_SOM1' EGA SOM2 ( ABS ( SOM2 * 0.05 ))) ) ;
  23517. * MESS ' >>>>verifiez vos valeurs, desole ' ;
  23518. * ERREUR 'VALEUR_DU_FLUX_RENTRANT' ;
  23519. * FINSI ;
  23520. @CALOR TAB1 PUI1 ;
  23521. TIN = TAB1 . T_IN ;
  23522. * CPF = @IPOE TIN TAB1.ETCPF ;
  23523. * EMDOTI = TAB1.V_EMDOTI ;
  23524. * TOUT = TIN + (PUI1 / (EMDOTI * CPF)) ;
  23525. * TAB1.'T_LOCAL' = TIN + ((TOUT - TIN ) * TAB1.X_LOCAL) ;
  23526. * TMOY = (TIN + TOUT) / 2. ;
  23527. * TMOY= TAB1.'T_MOY' ;
  23528.  
  23529.  
  23530. *
  23531. *--- APPEL PROCEDURE CALCUL DE 'H CONVECTION (TRANS)'
  23532. *
  23533. SI ( EXISTE TAB1 PFIXTONB ) ;
  23534. TAB1 . PFIXTONB = VRAI ;
  23535. SINON ;
  23536. TAB1 . PFIXTONB = FAUX ;
  23537. FINSI ;
  23538.  
  23539. SI ( NON ( EXISTE TAB1 TETA )) ;
  23540. TAB1.'TETA' = TAB1.'T_LOCAL';
  23541. * TAB1 . 'TETA' = TIN ;
  23542. * MESS '>@TTRANS> Initial Temperature set to TIN';
  23543. FINSI ;
  23544. *
  23545. *SI( NON (EXISTE TAB1 NO_CONV)) ;
  23546. @FLUCRIT TAB1 ;
  23547. * RM 13.03.1997
  23548. SI (TAB1.COUPE_ECH_A_CHF) ;
  23549. TAB1.FLUCRIT1 = TAB1.CHF;
  23550. FINSI ;
  23551. @CALHCON TAB1 ;
  23552. TAB1.'CONVECTION' = TABLE ;
  23553. TAB1.'CONVECTION' . 'MAILLAGE' = TAB1 . LFLUX_CONV ;
  23554. TAB1.'CONVECTION' . 'EVOCONV' = EVOL MANU 'TEMPERATURE' ( EXTR TAB1.ECONVEC1 'ABSC' ) 'COEFFICIENT ECHANGE' ( EXTR TAB1.ECONVEC1 'ORDO' ) ;
  23555. TAB1.'CONVECTION' . 'TEMP_EXT' = TAB1.'TETA' ;
  23556. *FINSI ;
  23557.  
  23558.  
  23559. *
  23560. *
  23561. *--- APPEL PROCEDURE CALCUL DE 'H RAYONNEMENT'
  23562. *
  23563. *
  23564. ERAYON1 = @CALHRAY TAB1 ;
  23565. *
  23566.  
  23567. MOT1 = ' TRANSITOIRE NONLINEAIRE METHODE DUPONT2 ' ;
  23568. TAB1.'SOUSTYPE' = THERMIQUE ;
  23569.  
  23570.  
  23571. S_TOT1 = TAB1.'M_ILLAGE_TOT' ;
  23572. SI ( NON ( EXISTE TAB1 'INITIAL(0)')) ;
  23573. TAB1.'INITIAL(0)' = MANU CHPO S_TOT1 1 'T' TAB1.'TETA' ;
  23574. TAB1.'INITIAL(1)' = MANU CHPO S_TOT1 1 'T' TAB1.'TETA' ;
  23575. SINON ;
  23576. SI ( NON ( EXISTE TAB1 'INITIAL(1)')) ;
  23577. TAB1.'INITIAL(1)' = TAB1.'INITIAL(0)' ;
  23578. FINSI ;
  23579. FINSI ;
  23580. TAB1.'RAYONNEMEN' = TABLE ;
  23581. TAB1.'RAYONNEMEN' . 'MAILLAGE' = TAB1 . LFLUX_RAYO ;
  23582. TAB1.'RAYONNEMEN' . 'EVORAYO' = ERAYON1 ;
  23583. TAB1.'RAYONNEMEN' . 'TEMP_EXT' = TAB1 . TEMP_RAYO ;
  23584. FPAT2 = FPAT1 ;
  23585. SI ( EXISTE TAB1 V_SOURCE ) ;
  23586. FPAT2 = FPAT1 ET TAB1.FSOU1 ;
  23587. FINSI ;
  23588. FPAT3 = FPAT2 ;
  23589. SI ( EXISTE TAB1 FLUX_IMP ) ;
  23590. FPAT3 = FPAT2 ET TAB1.FLUX_IMP ;
  23591. FINSI ;
  23592. TAB1.'FLUX' = CHAR 'Q' FPAT3 ( EVOL MANU 'TEMPS' ( TAB1.'PTF1') (TAB1.'PCF1') ) ;
  23593. * RM 11.03.97
  23594. @TRANSI3 TAB1 ;
  23595. * TEMPS ;
  23596.  
  23597. FINSI ;
  23598. FINPROC ;
  23599. *
  23600. *----------Fin de la procedure @TTRANS
  23601. *--------------------------------------------------------------------
  23602.  
  23603. **** @CVECT
  23604. DEBPROC @CVECT XV*CHPOINT YV*CHPOINT ZV*CHPOINT MAIL0*MAILLAGE COUL0*MOT AMPLI0/FLOTTANT;
  23605. *
  23606. **************************************************************
  23607. * Procedure de creation d'un objet de type vecteur a partir *
  23608. * des composantes d'un champ de vecteurs. *
  23609. * Si le facteur d'amplification pour visualiser un champ de *
  23610. * vecteur sur une geometrie n'est pas donne,il est adapte *
  23611. * aux dimensions geometriques du probleme. *
  23612. * Alain MOAL (juillet 1995) *
  23613. **************************************************************
  23614. *
  23615. XM = COOR 1 MAIL0 ;
  23616. YM = COOR 2 MAIL0 ;
  23617. SI ((VALEUR DIME) EGA 2) ;
  23618. ZM = XM * 0. ;
  23619. SINON ;
  23620. ZM = COOR 3 MAIL0 ;
  23621. FINSI ;
  23622. *
  23623. SI (NON (EXISTE AMPLI0)) ;
  23624. * ---- norme du vecteur
  23625. VECNORM = ((XV * XV) + (YV * YV) + (ZV * ZV))**0.5 ;
  23626. *
  23627. * ---- calcul d'une longueur caracteristique du maillage
  23628. LONGCAR1 = ABS ((MAXI XM) - (MINI XM)) ;
  23629. LONGCAR2 = ABS ((MAXI YM) - (MINI YM)) ;
  23630. LONGCAR3 = ABS ((MAXI ZM) - (MINI ZM)) ;
  23631. *
  23632. SI ((VALEUR DIME) EGA 2) ;
  23633. LONGCAR = MINI (PROG LONGCAR1 LONGCAR2) ;
  23634. SINON ;
  23635. LONGCAR = MINI (PROG LONGCAR1 LONGCAR2 LONGCAR3) ;
  23636. FINSI ;
  23637. *
  23638. AMPLI0 = LONGCAR / (MAXI VECNORM) / 3.;
  23639. *AM* AMPLI0 = LONGCAR / (MAXI VECNORM) ;
  23640. *AM* AMPLI0 = 2. * LONGCAR / (MAXI VECNORM) ;
  23641. FINSI ;
  23642. *
  23643. SI ((VALEUR DIME) EGA 2) ;
  23644. CHV1 = @ET (NOMC UX XV) (NOMC UY YV) ;
  23645.  
  23646.  
  23647. *CAST94* CHV1 = (NOMC UX XV) ET (NOMC UY YV) ;
  23648. VECT1 = VECT CHV1 AMPLI0 UX UY COUL0 ;
  23649. SINON ;
  23650. CHV1 = @ET (@ET (NOMC UX XV) (NOMC UY YV)) (NOMC UZ ZV) ;
  23651. *CAST94* CHV1 = (NOMC UX XV) ET (NOMC UY YV) ET (NOMC UZ ZV) ;
  23652. VECT1 = VECT CHV1 AMPLI0 UX UY UZ COUL0 ;
  23653. FINSI ;
  23654. FINPROC VECT1 ;
  23655.  
  23656.  
  23657. DEBPROC @VISRES TAB1*TABLE ;
  23658. *
  23659. ******************************************************************
  23660. * Procedure de visualisation des resultats d'un calcul permanent *
  23661. * en 3D. Alain MOAL (aout-sept 1995) *
  23662. ******************************************************************
  23663. *
  23664. MESS '---------------------------------> calling @VISRES';
  23665. *
  23666. ITER = 1 ;
  23667. *--------------- VARIABLES D'ENTREE :
  23668. MAIL0 = TAB1.<MAILLAGE ;
  23669. TEMP = TAB1.TEMPERATURE ;
  23670. LIGCONV = TAB1.LFLUX_CONV_DESS ;
  23671. SURFCONV = TAB1.LFLUX_CONV ;
  23672. SURFEXTE = TAB1.LFLUX_EXTE ;
  23673. TE1 = TAB1.ITER ;
  23674. VTETA1 = TAB1.RESUTHER.'VALEUR_TETA'.ITER ;
  23675. HCONV1 = TAB1.RESUTHER.COEFECHANGE.ITER ;
  23676. PROFIL0 = TAB1.V_VPAT1 ;
  23677. FLU0 = EXTR TAB1.LIS_FLUX ITER;
  23678. MODEL0 = TAB1.MODELF ;
  23679. LIG0 = TAB1.LFLUX_EXTE_DESS ;
  23680. MAXSOFL = TAB1.MAX_SOFL ;
  23681. DMAQ0 = TAB1.D_MAQUETTE ;
  23682. NX = TAB1.C_COTETF1 ;
  23683. NY = TAB1.C_SITETF1 ;
  23684. NZ = TAB1.C_COS3F1 ;
  23685. VOLMAT1 = TAB1.ZONE_MAT.1 ;
  23686. VOLMAT2 = TAB1.ZONE_MAT.2 ;
  23687. VOLMAT3 = TAB1.ZONE_MAT.3 ;
  23688. ANGINCI = TAB1.<ANGINCI;
  23689. *TEST*VBVN = TAB1.<VBVN ;
  23690. SI ((DIME TAB1.<POINT_COUPE) EGA 3) ;
  23691. P1 = TEXT (EXTR TAB1.<POINT_COUPE 1) ;
  23692. P2 = TEXT (EXTR TAB1.<POINT_COUPE 2) ;
  23693. P3 = TEXT (EXTR TAB1.<POINT_COUPE 3) ;
  23694. SINON ;
  23695. ERRE '>>>> @VISRES : check TAB1.<POINT_COUPE' ;
  23696. FINSI ;
  23697. SI ((VALEUR DIME) EGA 3) ;
  23698. OEIL0 = TAB1.VIEW_P ;
  23699. SINON ;
  23700. ERRE '>>>> @VISRES only works on 3D geometries' ;
  23701. FINSI ;
  23702. *------------------------------------
  23703. *
  23704. *---- Table de visualisation
  23705. TAB2 = TABLE ;
  23706. TAB2.1 = 'MARQ CROI REGU MOT TITR FLUX' ;
  23707. TAB2.2 = 'MARQ TRIA REGU MOT TITR TEMPERATURE' ;
  23708. *
  23709. SI ((VALEUR DIME) NEG 3) ;
  23710. ERRE '>>>> @VISRES only works on 3D modelisations';
  23711. FINSI ;
  23712. *
  23713. FLU1 = FLU0 * PROFIL0 ;
  23714. *
  23715. *---- Trace du flux incident, de la temperature et de l'angle d'incidence
  23716. *---- le long d'une ligne en fonction de l'abscisse curviligne
  23717. XM = COOR 1 LIG0 ;
  23718. LIG2 = CHAN SEG2 LIG0 ;
  23719. XCUR = EXTR (EVOL CHPO XM SCAL (INVE LIG0)) ABSC ;
  23720. CHXCUR = MANU CHPO (INVE LIG2) 1 SCAL XCUR ;
  23721. FLUXI = NOMC SCAL FLU1 ;
  23722. TEMP1 = NOMC SCAL TEMP ;
  23723. TITRE ' @VISRES : INCIDENT FLUX (W/m2) AND TEMPERATURE (1.E-4*C)';
  23724. EVFLUI = EVOL JAUN CHPO FLUXI SCAL LIG0 ;
  23725. EVTEMI = EVOL ROUG CHPO (TEMP1*1.E4) SCAL LIG0 ;
  23726. DESSIN (EVFLUI ET EVTEMI) MIMA LEGE TAB2 ;
  23727. TITRE ' @VISRES : ANGLE BETWEEN B AND N (degree)';
  23728. EVANGI = EVOL JAUN CHPO ANGINCI SCAL LIG0 ;
  23729. DESSIN EVANGI MIMA ;
  23730. *TEST*TITRE ' @VISRES : VBVN ';
  23731. *TEST*EVVBVN = EVOL JAUN CHPO VBVN SCAL LIG0 ;
  23732. *TEST*DESSIN EVVBVN MIMA ;
  23733. *
  23734. *---- Trace de l'evolution du flux de convection le long d'une ligne
  23735. VTETA0 = REDU (EXCO 'T' TE1) LIGCONV ;
  23736. SI (EGA (TYPE VTETA1) 'CHPOINT ');
  23737. VTETA = EXCO 'T' VTETA1 ;
  23738. SINON ;
  23739. VTETA = VTETA1 ;
  23740. FINSI ;
  23741. HCONV = EXCO 'H' HCONV1 ;
  23742. *
  23743. *---- flux de convection sur la ligne et temperatures sur la ligne
  23744. FLUCONV = HCONV * (VTETA0 - VTETA) ;
  23745. TITRE '@VISRES : WALL FLUX (W/m2) AND WALL TEMPERATURE (1.E-5*C)' ;
  23746. EVFLUC = EVOL VERT CHPO FLUCONV SCAL LIGCONV ;
  23747. EVTEMC = EVOL TURQ CHPO (TEMP1*1.E5) SCAL LIGCONV ;
  23748. DESSIN (EVFLUC ET EVTEMC) MIMA LEGE TAB2 ;
  23749. *
  23750. *---- temperatures sur la ligne
  23751. *TITRE '@VISRES : WALL TEMPERATURE (C)' ;
  23752. *DESSIN (EVOL TURQ CHPO TEMP1 SCAL LIGCONV) MIMA ;
  23753. *
  23754. *---- flux de convection sur la surface de convection
  23755. FLUCONV0 = HCONV * (TE1 - VTETA) ;
  23756. *
  23757. *---- Calcul du facteur de concentration et de la puissance extraite
  23758. FACT0 = (MAXI FLUCONV0) / (MAXI FLU1);
  23759. FLUINT1 = FLUX MODEL0 FLU1 ;
  23760. FLUMOY = (MAXI(RESU FLUINT1)) / (MESU SURFEXTE) ;
  23761. PUI1 = MAXI(RESU FLUINT1) ;
  23762. *
  23763. *---- Trace en coupe des isovaleurs de temperature et des vecteurs flux
  23764. *---- incident et de convection
  23765. CHPX = EXCO SCAL (FLU1 * NX) UX ;
  23766. CHPY = EXCO SCAL (FLU1 * NY) UY ;
  23767. CHPZ = EXCO SCAL (FLU1 * NZ) UZ ;
  23768. CHPT = @ET (@ET CHPX CHPY) CHPZ ;
  23769. AMPLV1 = 10. * DMAQ0 / (2. * MAXSOFL) ;
  23770. VECFLUI = @VECADA CHPT (-1. * AMPLV1) 'ROUGE' ;
  23771. *FX = FLU1 * NX;
  23772. *FY = FLU1 * NY;
  23773. *FZ = FLU1 * NZ;
  23774. *VECFLUI = @CVECT FX FY FZ SURFEXTE VERT ;
  23775. TITRE '@VISRES : ISOTHERM IN SECTION' ;
  23776. TRAC OEIL0 COUPE P1 P2 P3 TEMP MAIL0;
  23777. *
  23778. *---- Trace des isovaleurs de temperature sans le maillage
  23779. TITRE '@VISRES : ISOTHERM, CONVECTED POWER 'PUI1' W';
  23780. SI (EGA (VALEUR ELEM) 'CUB8') ;
  23781. ARET1 = ARETE VOLMAT1 ;
  23782. ARET2 = ARETE VOLMAT2 ;
  23783. ARET3 = ARETE VOLMAT3 ;
  23784. SINON ;
  23785. ARET1 = ARETE VOLMAT1 40.;
  23786. ARET2 = ARETE VOLMAT2 40.;
  23787. ARET3 = ARETE VOLMAT3 40.;
  23788. FINSI ;
  23789. ARET0 = ARET1 ET ARET2 ET ARET3 ;
  23790. TRAC CACH OEIL0 7 TEMP MAIL0 ARET0 ;
  23791. TRAC CACH OEIL0 TEMP MAIL0 ARET0 ;
  23792. *
  23793. *---- Messages
  23794. MESS ' HIGHEST WALL TEMPERATURE (C)..........: ' (MAXI VTETA0);
  23795. MESS ' LOWEST WALL TEMPERATURE (C)...........: ' (MINI VTETA0);
  23796. MESS ' MEAN INCIDENT FLUX (W/m2).............: ' FLUMOY ;
  23797. MESS ' HIGHEST INCIDENT FLUX (W/m2)..........: ' (MAXI FLU1) ;
  23798. MESS ' LOWEST INCIDENT FLUX (W/m2)...........: ' (MINI FLU1) ;
  23799. MESS ' HIGHEST CONVECTION FLUX (W/m2)........: ' (MAXI FLUCONV0);
  23800. MESS ' LOWEST CONVECTION FLUX (W/m2).........: ' (MINI FLUCONV0);
  23801. MESS ' CONCENTRATION FACTOR .................: ' FACT0 ;
  23802. *
  23803. MESS '---------------------------------> exiting @VISRES';
  23804. FINPROC ;
  23805. **** @VDEFAUT
  23806. DEBPROC @VDEFAUT TAB1*TABLE ;
  23807. *
  23808. **********************************************************************
  23809. * Procedure de preparation de la table TAB1 pour le calcul du profil *
  23810. * du depot de puissance par la procedure @TOKAFLU. *
  23811. * On donne ici les valeurs par defaut et on verifie l'existence de *
  23812. * certains indices importants de la table. Alain MOAL (juillet 1995) *
  23813. **********************************************************************
  23814. *
  23815. MESS '---------------------------------> calling @VDEFAUT ';
  23816. SI (NON (EXISTE TAB1 <IMESS)) ;
  23817. TAB1.<IMESS = 1 ;
  23818. MESS 'The level of message on screen is : 1';
  23819. FINSI;
  23820. SI (NON (EXISTE TAB1 <ITRAC)) ;
  23821. TAB1.<ITRAC = VRAI ;
  23822. MESS 'Drawings are printed on screen';
  23823. FINSI;
  23824. SI (NON (EXISTE TAB1 <COEFA)) ;
  23825. TAB1.<COEFA = 5.8E-5 ;
  23826. MESS 'The first coefficient of the ripple model is : 5.8E-5';
  23827. FINSI;
  23828. SI (NON (EXISTE TAB1 <COEFB)) ;
  23829. TAB1.<COEFB = 5.5 ;
  23830. MESS 'The second coefficient of the ripple model is : 5.5';
  23831. FINSI;
  23832. SI (NON (EXISTE TAB1 <COEFC)) ;
  23833. TAB1.<COEFC = 4.5E-5 ;
  23834. MESS 'The third coefficient of the ripple model is : 4.5E-5';
  23835. FINSI;
  23836. SI (NON (EXISTE TAB1 <EPS)) ;
  23837. TAB1.<EPS = 1.E-5 ;
  23838. MESS 'The convergence criterium is : 1.E-5';
  23839. FINSI;
  23840. SI (NON (EXISTE TAB1 <RR)) ;
  23841. TAB1.<RR = 2.20 ;
  23842. MESS 'The large radius of the ripple referential is : 2.20 m';
  23843. FINSI;
  23844. SI (NON (EXISTE TAB1 <RP)) ;
  23845. MESS 'You must give the value of the large plasma radius';
  23846. ERRE '>>>> TAB1.<RP is missing' ;
  23847. FINSI;
  23848. SI (NON (EXISTE TAB1 <HP)) ;
  23849. TAB1.<HP = 0. ;
  23850. MESS 'The height of the plasma center is : 0. m';
  23851. FINSI;
  23852. SI (NON (EXISTE TAB1 <IPLASMA)) ;
  23853. MESS 'You must give the value of the plasma current' ;
  23854. ERRE '>>>> TAB1.<IPLASMA is missing ' ;
  23855. FINSI;
  23856. SI (NON (EXISTE TAB1 <INTENS)) ;
  23857. MESS 'You must give the value of the current in each whorl';
  23858. MESS 'of coils';
  23859. ERRE '>>>> TAB1.<INTENS is missing ' ;
  23860. FINSI;
  23861. SI (NON (EXISTE TAB1 <LAMB)) ;
  23862. MESS 'You must give the value of the asymmetrical factor ';
  23863. MESS 'of the poloidal field';
  23864. ERRE '>>>> TAB1.<LAMB is missing ' ;
  23865. FINSI;
  23866. SI (NON (EXISTE TAB1 <THETA0)) ;
  23867. TAB1.<THETA0 = 0. ;
  23868. *AM*MESS 'The THETA angle locating the part into the tokamak is : 0.';
  23869. FINSI;
  23870. *
  23871. * RM attention, ce <ANGPHI0 n a rien a voir avec <ANG_PHI0
  23872. *
  23873. SI (NON (EXISTE TAB1 <ANGPHI0)) ;
  23874. TAB1.<ANGPHI0 = 0. ;
  23875. FINSI;
  23876. SI (NON (EXISTE TAB1 <THETAREF)) ;
  23877. TAB1.<THETAREF = -90. ;
  23878. MESS 'The reference angle for lambdaq is : -90. degrees';
  23879. FINSI;
  23880. SI (NON (EXISTE TAB1 <LAMBQREF)) ;
  23881. *AM* TAB1.<LAMBQREF = 15.4 /((TAB1.<IPLASMA)**0.5) ;
  23882. MESS 'You must give the value of the reference decrease length ';
  23883. ERRE '>>>> TAB1.<LAMBQREF is missing ' ;
  23884. FINSI;
  23885. SI (NON (EXISTE TAB1 <TYPE_CALCUL)) ;
  23886. TAB1.<TYPE_CALCUL = MOT 'AVEC_SHIFT_AVEC_RIPPLE' ;
  23887. MESS 'The option of computation is : AVEC_SHIFT_AVEC_RIPPLE';
  23888. FINSI;
  23889. SI (NON (EXISTE TAB1 <MODEL_CHAMP)) ;
  23890. TAB1.<MODEL_CHAMP = MOT 'SHAFRANOV' ;
  23891. MESS 'The poloidal magnetic field model is : SHAFRANOV';
  23892. FINSI;
  23893. SI (NON (EXISTE TAB1 <NBOB)) ;
  23894. TAB1.<NBOB = 18 ;
  23895. MESS 'The number of coils is : 18 ';
  23896. FINSI;
  23897. SI (NON (EXISTE TAB1 <NSPI)) ;
  23898. TAB1.<NSPI = 2028 ;
  23899. MESS 'The number of whorls in each coil is : 2028 ';
  23900. FINSI;
  23901.  
  23902. SI ((VALEUR DIME) EGA 2) ;
  23903. SI (NON (EXISTE TAB1 <PLAN)) ;
  23904. MESS 'You must give the kind of 2D section ';
  23905. ERRE '>>>> TAB1.<PLAN is missing ' ;
  23906. FINSI ;
  23907. SI (EGA TAB1.<PLAN 'THECONS') ;
  23908. SI (NON (EXISTE TAB1 <THETA0)) ;
  23909. MESS 'You must give the THETA angle locating';
  23910. MESS 'the part into the tokamak' ;
  23911. ERRE '>>>> TAB1.<THETA0 is missing ' ;
  23912. FINSI ;
  23913. SI (NON (EXISTE TAB1 CENTRE_PLASMA)) ;
  23914. MESS 'You must give the plasma center ';
  23915. ERRE '>>>> TAB1.CENTRE_PLASMA is missing';
  23916. FINSI ;
  23917. FINSI ;
  23918. SI (EGA TAB1.<PLAN 'PHICONS') ;
  23919. SI (NON (EXISTE TAB1 <CENTRE_TORE)) ;
  23920. MESS 'You must give the tokamak center' ;
  23921. ERRE '>>>> TAB1.<CENTRE_TORE is missing' ;
  23922. FINSI ;
  23923. SI (NON (EXISTE TAB1 <POINT_SUR_AXE_TORE)) ;
  23924. MESS 'You must give a second point on the tokamak axis';
  23925. ERRE '>>>> TAB1.<POINT_SUR_AXE_TORE is missing';
  23926. FINSI ;
  23927. SI (NON (EXISTE TAB1 <POINT_SUR_OBJET)) ;
  23928. MESS 'You must give a reference point on the part';
  23929. ERRE '>>>> TAB1.<POINT_SUR_OBJET is missing';
  23930. FINSI ;
  23931. FINSI ;
  23932. SI (NON (EXISTE TAB1 LFLUX_EXTE_DESS)) ;
  23933. TAB1.LFLUX_EXTE_DESS = TAB1.LFLUX_EXTE ;
  23934. FINSI ;
  23935. FINSI;
  23936.  
  23937. SI ((VALEUR DIME) EGA 3);
  23938. SI (NON (EXISTE TAB1 <CENTRE_TORE)) ;
  23939. MESS 'You must give the tokamak center' ;
  23940. ERRE '>>>> TAB1.<CENTRE_TORE is missing' ;
  23941. FINSI ;
  23942. SI (NON (EXISTE TAB1 <POINT_SUR_AXE_TORE)) ;
  23943. MESS 'You must give a second point on the tokamak axis';
  23944. ERRE '>>>> TAB1.<POINT_SUR_AXE_TORE is missing';
  23945. FINSI ;
  23946. SI (NON (EXISTE TAB1 <POINT_SUR_OBJET)) ;
  23947. MESS 'You must give a reference point on the part';
  23948. ERRE '>>>> TAB1.<POINT_SUR_OBJET is missing';
  23949. FINSI ;
  23950. FINSI ;
  23951.  
  23952. SI (NON (EXISTE TAB1 <ANG_PHI0)) ;
  23953. MESS 'You must give the initial toroidal angle ';
  23954. MESS 'locating the reference point of the part ';
  23955. MESS 'in the tokamak';
  23956. ERRE '>>>> TAB1.<ANG_PHI0 is missing' ;
  23957. FINSI ;
  23958. SI ((VALEUR DIME) EGA 3) ;
  23959. SI (NON (EXISTE TAB1 VIEW_P)) ;
  23960. TAB1.VIEW_P = -1000. 1000. 1000. ;
  23961. FINSI;
  23962. FINSI;
  23963. *
  23964. *---- norme du champ magnetique toroidal au centre du plasma
  23965. * rm 24.07.97 BTOR0 = 2.E-7 * TAB1.<NBOB * TAB1.<NSPI * TAB1.<INTENS / TAB1.<RP
  23966. ;
  23967. BTOR0 = -2.E-7 * TAB1.<NBOB * TAB1.<NSPI * TAB1.<INTENS / TAB1.<RP ;
  23968. MESS 'The toroidal magnetic field at the plasma center is (T): 'BTOR0;
  23969. *
  23970. MESS '---------------------------------> exiting @VDEFAUT ';
  23971. FINPROC ;
  23972.  
  23973. **** @VDEFAUT
  23974. DEBPROC @VDEFAUT TAB1*TABLE ;
  23975. *
  23976. **********************************************************************
  23977. * Procedure de preparation de la table TAB1 pour le calcul du profil *
  23978. * du depot de puissance par la procedure @TOKAFLU. *
  23979. * On donne ici les valeurs par defaut et on verifie l'existence de *
  23980. * certains indices importants de la table. Alain MOAL (juillet 1995) *
  23981. **********************************************************************
  23982. *
  23983. MESS '---------------------------------> calling @VDEFAUT ';
  23984. SI (NON (EXISTE TAB1 <IMESS)) ;
  23985. TAB1.<IMESS = 1 ;
  23986. MESS 'The level of message on screen is : 1';
  23987. FINSI;
  23988. SI (NON (EXISTE TAB1 <ITRAC)) ;
  23989. TAB1.<ITRAC = VRAI ;
  23990. MESS 'Drawings are printed on screen';
  23991. FINSI;
  23992. SI (NON (EXISTE TAB1 <COEFA)) ;
  23993. TAB1.<COEFA = 5.8E-5 ;
  23994. MESS 'The first coefficient of the ripple model is : 5.8E-5';
  23995. FINSI;
  23996. SI (NON (EXISTE TAB1 <COEFB)) ;
  23997. TAB1.<COEFB = 5.5 ;
  23998. MESS 'The second coefficient of the ripple model is : 5.5';
  23999. FINSI;
  24000. SI (NON (EXISTE TAB1 <COEFC)) ;
  24001. TAB1.<COEFC = 4.5E-5 ;
  24002. MESS 'The third coefficient of the ripple model is : 4.5E-5';
  24003. FINSI;
  24004. SI (NON (EXISTE TAB1 <EPS)) ;
  24005. TAB1.<EPS = 1.E-5 ;
  24006. MESS 'The convergence criterium is : 1.E-5';
  24007. FINSI;
  24008. SI (NON (EXISTE TAB1 <RR)) ;
  24009. TAB1.<RR = 2.20 ;
  24010. MESS 'The large radius of the ripple referential is : 2.20 m';
  24011. FINSI;
  24012. SI (NON (EXISTE TAB1 <RP)) ;
  24013. MESS 'You must give the value of the large plasma radius';
  24014. ERRE '>>>> TAB1.<RP is missing' ;
  24015. FINSI;
  24016. SI (NON (EXISTE TAB1 <HP)) ;
  24017. TAB1.<HP = 0. ;
  24018. MESS 'The height of the plasma center is : 0. m';
  24019. FINSI;
  24020. SI (NON (EXISTE TAB1 <IPLASMA)) ;
  24021. MESS 'You must give the value of the plasma current' ;
  24022. ERRE '>>>> TAB1.<IPLASMA is missing ' ;
  24023. FINSI;
  24024. SI (NON (EXISTE TAB1 <INTENS)) ;
  24025. MESS 'You must give the value of the current in each whorl';
  24026. MESS 'of coils';
  24027. ERRE '>>>> TAB1.<INTENS is missing ' ;
  24028. FINSI;
  24029. SI (NON (EXISTE TAB1 <LAMB)) ;
  24030. MESS 'You must give the value of the asymmetrical factor ';
  24031. MESS 'of the poloidal field';
  24032. ERRE '>>>> TAB1.<LAMB is missing ' ;
  24033. FINSI;
  24034. SI (NON (EXISTE TAB1 <THETA0)) ;
  24035. TAB1.<THETA0 = 0. ;
  24036. *AM*MESS 'The THETA angle locating the part into the tokamak is : 0.';
  24037. FINSI;
  24038. *
  24039. * RM attention, ce <ANGPHI0 n a rien a voir avec <ANG_PHI0
  24040. *
  24041. SI (NON (EXISTE TAB1 <ANGPHI0)) ;
  24042. TAB1.<ANGPHI0 = 0. ;
  24043. FINSI;
  24044. SI (NON (EXISTE TAB1 <THETAREF)) ;
  24045. TAB1.<THETAREF = -90. ;
  24046. MESS 'The reference angle for lambdaq is : -90. degrees';
  24047. FINSI;
  24048. SI (NON (EXISTE TAB1 <LAMBQREF)) ;
  24049. *AM* TAB1.<LAMBQREF = 15.4 /((TAB1.<IPLASMA)**0.5) ;
  24050. MESS 'You must give the value of the reference decrease length ';
  24051. ERRE '>>>> TAB1.<LAMBQREF is missing ' ;
  24052. FINSI;
  24053. SI (NON (EXISTE TAB1 <TYPE_CALCUL)) ;
  24054. TAB1.<TYPE_CALCUL = MOT 'AVEC_SHIFT_AVEC_RIPPLE' ;
  24055. MESS 'The option of computation is : AVEC_SHIFT_AVEC_RIPPLE';
  24056. FINSI;
  24057. SI (NON (EXISTE TAB1 <TYPE_DEPOT)) ;
  24058. TAB1.<TYPE_DEPOT = MOT 'PARALLELE' ;
  24059. MESS 'The heat deposition is : PARALLELE';
  24060. FINSI;
  24061. * RM le 08/12/1998
  24062. SI (NON ((EGA TAB1.<TYPE_DEPOT 'PARALLELE') OU (EGA TAB1.<TYPE_DEPOT 'PERPENDICULAIRE')));
  24063. ERRE '>>>>@VDEFAUT, DEFINTION OF TAB1.<TYPE_DEPOT';
  24064. FINSI ;
  24065. SI (NON (EXISTE TAB1 <MODEL_CHAMP)) ;
  24066. TAB1.<MODEL_CHAMP = MOT 'SHAFRANOV' ;
  24067. MESS 'The poloidal magnetic field model is : SHAFRANOV';
  24068. FINSI;
  24069. SI (NON (EXISTE TAB1 <NBOB)) ;
  24070. TAB1.<NBOB = 18 ;
  24071. MESS 'The number of coils is : 18 ';
  24072. FINSI;
  24073. SI (NON (EXISTE TAB1 <NSPI)) ;
  24074. TAB1.<NSPI = 2028 ;
  24075. MESS 'The number of whorls in each coil is : 2028 ';
  24076. FINSI;
  24077.  
  24078. SI ((VALEUR DIME) EGA 2) ;
  24079. SI (NON (EXISTE TAB1 <PLAN)) ;
  24080. MESS 'You must give the kind of 2D section ';
  24081. ERRE '>>>> TAB1.<PLAN is missing ' ;
  24082. FINSI ;
  24083. SI (EGA TAB1.<PLAN 'THECONS') ;
  24084. SI (NON (EXISTE TAB1 <THETA0)) ;
  24085. MESS 'You must give the THETA angle locating';
  24086. MESS 'the part into the tokamak' ;
  24087. ERRE '>>>> TAB1.<THETA0 is missing ' ;
  24088. FINSI ;
  24089. SI (NON (EXISTE TAB1 CENTRE_PLASMA)) ;
  24090. MESS 'You must give the plasma center ';
  24091. ERRE '>>>> TAB1.CENTRE_PLASMA is missing';
  24092. FINSI ;
  24093. FINSI ;
  24094. SI (EGA TAB1.<PLAN 'PHICONS') ;
  24095. SI (NON (EXISTE TAB1 <CENTRE_TORE)) ;
  24096. MESS 'You must give the tokamak center' ;
  24097. ERRE '>>>> TAB1.<CENTRE_TORE is missing' ;
  24098. FINSI ;
  24099. SI (NON (EXISTE TAB1 <POINT_SUR_AXE_TORE)) ;
  24100. MESS 'You must give a second point on the tokamak axis';
  24101. ERRE '>>>> TAB1.<POINT_SUR_AXE_TORE is missing';
  24102. FINSI ;
  24103. SI (NON (EXISTE TAB1 <POINT_SUR_OBJET)) ;
  24104. MESS 'You must give a reference point on the part';
  24105. ERRE '>>>> TAB1.<POINT_SUR_OBJET is missing';
  24106. FINSI ;
  24107. FINSI ;
  24108. SI (NON (EXISTE TAB1 LFLUX_EXTE_DESS)) ;
  24109. TAB1.LFLUX_EXTE_DESS = TAB1.LFLUX_EXTE ;
  24110. FINSI ;
  24111. FINSI;
  24112.  
  24113. SI ((VALEUR DIME) EGA 3);
  24114. SI (NON (EXISTE TAB1 <CENTRE_TORE)) ;
  24115. MESS 'You must give the tokamak center' ;
  24116. ERRE '>>>> TAB1.<CENTRE_TORE is missing' ;
  24117. FINSI ;
  24118. SI (NON (EXISTE TAB1 <POINT_SUR_AXE_TORE)) ;
  24119. MESS 'You must give a second point on the tokamak axis';
  24120. ERRE '>>>> TAB1.<POINT_SUR_AXE_TORE is missing';
  24121. FINSI ;
  24122. SI (NON (EXISTE TAB1 <POINT_SUR_OBJET)) ;
  24123. MESS 'You must give a reference point on the part';
  24124. ERRE '>>>> TAB1.<POINT_SUR_OBJET is missing';
  24125. FINSI ;
  24126. FINSI ;
  24127.  
  24128. SI (NON (EXISTE TAB1 <ANG_PHI0)) ;
  24129. MESS 'You must give the initial toroidal angle ';
  24130. MESS 'locating the reference point of the part ';
  24131. MESS 'in the tokamak';
  24132. ERRE '>>>> TAB1.<ANG_PHI0 is missing' ;
  24133. FINSI ;
  24134. SI ((VALEUR DIME) EGA 3) ;
  24135. SI (NON (EXISTE TAB1 VIEW_P)) ;
  24136. TAB1.VIEW_P = -1000. 1000. 1000. ;
  24137. FINSI;
  24138. FINSI;
  24139. *
  24140. *---- norme du champ magnetique toroidal au centre du plasma
  24141. * rm 24.07.97 BTOR0 = 2.E-7 * TAB1.<NBOB * TAB1.<NSPI * TAB1.<INTENS / TAB1.<RP
  24142. ;
  24143. BTOR0 = -2.E-7 * TAB1.<NBOB * TAB1.<NSPI * TAB1.<INTENS / TAB1.<RP ;
  24144. MESS 'The toroidal magnetic field at the plasma center is (T): 'BTOR0;
  24145. *
  24146. MESS '---------------------------------> exiting @VDEFAUT ';
  24147. FINPROC ;
  24148.  
  24149. **** @VDEFJET
  24150.  
  24151. DEBPROC @VDEFJET TAB1*TABLE ;
  24152. *
  24153. **********************************************************************
  24154. * Procedure de preparation de la table TAB1 pour le calcul du profil *
  24155. * du depot de puissance par la procedure @CFPFLU. *
  24156. * On donne ici les valeurs par defaut et on verifie l'existence de *
  24157. * certains indices importants de la table. Alain MOAL (Fevrier 2001) *
  24158. **********************************************************************
  24159. * Modif : *
  24160. * 08/11/01 (A.MOAL) : test sur TAB1.<PUISSANCE_TOTALE et sur *
  24161. * TAB1.<SENS_REMONTEE *
  24162. * 27/01/04 (A.MOAL) : ajout de TAB1.<ANG_PHI0 = 0 et *
  24163. * TAB1.<POINT_SUR_OBJET pour utiliser les memes *
  24164. * procedures que pour @TOKAFLU *
  24165. **********************************************************************
  24166. *
  24167. MESS '---------------------------------> calling @VDEFJET ';
  24168. SI (NON (EXISTE TAB1 <IMESS)) ;
  24169. TAB1.<IMESS = 1 ;
  24170. MESS 'The level of message on screen is : 1';
  24171. FINSI;
  24172. SI (NON (EXISTE TAB1 <ITRAC)) ;
  24173. TAB1.<ITRAC = VRAI ;
  24174. MESS 'Drawings are printed on screen';
  24175. FINSI;
  24176. SI ((VALEUR DIME) EGA 2) ;
  24177. MESS 'Computation in 2 dimensions is not available';
  24178. ERRE '>>>> You must work in 3 dimensions' ;
  24179. FINSI;
  24180. SI ((VALEUR DIME) EGA 3);
  24181. SI (NON (EXISTE TAB1 <CENTRE_TORE)) ;
  24182. MESS 'The tokamak center is (0. 0. 0.)' ;
  24183. TAB1.<CENTRE_TORE = 0. 0. 0. ;
  24184. * MESS 'You must give the tokamak center' ;
  24185. * ERRE '>>>> TAB1.<CENTRE_TORE is missing' ;
  24186. FINSI ;
  24187. SI (NON (EXISTE TAB1 <POINT_SUR_AXE_TORE)) ;
  24188. MESS 'The vertical axis is defined by the point (0. 0. 1.)';
  24189. TAB1.<POINT_SUR_AXE_TORE = 0. 0. 1. ;
  24190. * MESS 'You must give a second point on the tokamak axis';
  24191. * ERRE '>>>> TAB1.<POINT_SUR_AXE_TORE is missing';
  24192. FINSI ;
  24193. *AM*27/01/04
  24194. TAB1.<ANG_PHI0 = 0. ;
  24195. TAB1.<POINT_SUR_OBJET = 1. 0. 0.;
  24196. FINSI ;
  24197. SI ((VALEUR DIME) EGA 3) ;
  24198. SI (NON (EXISTE TAB1 VIEW_P)) ;
  24199. TAB1.VIEW_P = -1000. 1000. 1000. ;
  24200. FINSI;
  24201. FINSI;
  24202. SI (NON (EXISTE TAB1 <TYPE_DEPOT)) ;
  24203. TAB1.<TYPE_DEPOT = VRAI ;
  24204. MESS 'The heat deposition is : PARALLELE';
  24205. FINSI;
  24206. SI (NON (EXISTE TAB1 <CALCUL_INCIDENCE)) ;
  24207. TAB1.<CALCUL_INCIDENCE = FAUX ;
  24208. FINSI;
  24209. SI (NON (EXISTE TAB1 <PUISSANCE_TOTALE)) ;
  24210. MESS 'You must give the total power deposited (MW)';
  24211. ERRE '>>>> TAB1.<PUISSANCE_TOTALE is missing' ;
  24212. FINSI;
  24213. SI (NON (EXISTE TAB1 <SENS_REMONTEE)) ;
  24214. TAB1.<SENS_REMONTEE = 0 ;
  24215. FINSI;
  24216. *
  24217. MESS '---------------------------------> exiting @VDEFJET ';
  24218. FINPROC ;
  24219.  
  24220. **** @VECADA
  24221. DEBPROC @VECADA <CHP1*CHPOINT <AMPL1*FLOTTANT <MOT1*MOT;
  24222. V_DIM1 = VALEUR 'DIME' ;
  24223. SI ( V_DIM1 EGA 2) ;
  24224. >VECT1 = VECTEUR <CHP1 <AMPL1 UX UY <MOT1;
  24225. SINON ;
  24226. >VECT1 = VECTEUR <CHP1 <AMPL1 UX UY UZ <MOT1 ;
  24227. FINSI ;
  24228. FINPROC >VECT1 ;
  24229. **** @VECGRAD
  24230. DEBPROC @VECGRAD TAB1*TABLE <CHP1*CHPOINT <AMPL1*FLOTTANT <MOT1*MOT;
  24231. MESS '---------------------------------> entree dans @VECGRAD';
  24232. MESS 'ATTENTION PAS ENCORE AU POINT !!!!!!!!!!!!!!!!!!!';
  24233. V1 = VALE DIME ;
  24234. SI (NON (EGA V1 2)) ;
  24235. MESS 'ERREUR dans lemploi de @VECGRAD...on nest pas en 2D' ERRE '@VECGRAD';
  24236. FINSI ;
  24237. S_TOT1 = TAB1.'M_ILLAGE_TOT';
  24238. CON_1 = TAB1.'M_IL_CONTOUR';
  24239. IZ = 0 ;
  24240. REPE BOU11 ;
  24241. IZ = IZ + 1 ;
  24242. SI ( NON ( EXISTE (TAB1.ZONE_MAT) IZ)) ;
  24243. QUITTER BOU11 ;
  24244. FINSI ;
  24245. MOD_1 = TAB1.DEF_MO.IZ ;
  24246. MAI_1 = TAB1.ZONE_MAT.IZ ;
  24247. CHT_2 = REDU <CHP1 MAI_1 ;
  24248. GR_1 = CHAN NOEUD (GRAD MOD_1 CHT_2) MOD_1;
  24249. GR_1 = CHAN CHPO GR_1 MOD_1;
  24250. VK_1 = @EVMAT TAB1.NOM_MAT.IZ 'CONDUCTIVITE' CHT_2 ;
  24251. VK_1 = NOMC 'SCAL' (-1. * VK_1 ) ;
  24252. FL_1 = VK_1 * GR_1;
  24253.  
  24254. CHN1 = MANU CHPO MAI_1 1 'SCAL' 1. ;
  24255.  
  24256.  
  24257. SI ( IZ EGA 1 ) ;
  24258. FL_T = FL_1 ;
  24259. CHN2 = CHN1 ;
  24260. LIST ((MAXI CHN2 ) - (MINI CHN2 ));
  24261. SINON ;
  24262. FL_T = FL_T ET FL_1 ;
  24263. CHN2 = CHN2 ET CHN1 ;
  24264. LIST ((MAXI CHN2 ) - (MINI CHN2 ));
  24265. FINSI ;
  24266. C_OLD = CC_1 ;
  24267. FIN BOU11 ;
  24268. FL_T = FL_T / CHN2;
  24269. >VECT1 = VECTEUR FL_T <AMPL1 T,X T,Y <MOT1;
  24270.  
  24271.  
  24272. MESS '---------------------------------> sortie de @VECGRAD';
  24273.  
  24274.  
  24275. FINPROC >VECT1;
  24276. **** @VERANG
  24277.  
  24278. DEBPROC @VERANG TAB1*TABLE ;
  24279. *
  24280. ********************************************************
  24281. * Procedure de creation de la ligne de reference (flux *
  24282. * normalise dans un fichier issu de PROTEUS) pour *
  24283. * verification des angles d'incidences. *
  24284. * Alain MOAL (Mars 2001) *
  24285. ********************************************************
  24286. *
  24287. MESS '---------------------------------> calling @VERANG';
  24288. *
  24289. *--------------- VARIABLES D'ENTREE :
  24290. NOM0 = TAB1.<NOM_FICHIER_F ;
  24291. *------------------------------------
  24292. *
  24293. OPTI ACQUERIR NOM0 ;
  24294. *---- lecture du nombre de lignes a lire dans le fichier
  24295. ACQU I*ENTIER ;
  24296. MESS '@VERANG IS READING 'I' LINES IN FILE 'NOM0 ;
  24297. *
  24298. *---- ligne de titre
  24299. ACQU MOT1*MOT MOT2*MOT MOT3*MOT MOT4*MOT MOT5*MOT MOT6*MOT MOT7*MOT ;
  24300. *
  24301. ACQU R0*FLOTTANT Z0*FLOTTANT DPSI1*FLOTTANT AEFF10*FLOTTANT DDPSI1*FLOTTANT PLEG1*FLOTTANT Q1*FLOTTANT ;
  24302. *
  24303. *---- creation du premier point
  24304. P0 = R0 0. Z0 ;
  24305. *
  24306. *
  24307. ACQU R1*FLOTTANT Z1*FLOTTANT DPSI1*FLOTTANT AEFF10*FLOTTANT DDPSI1*FLOTTANT PLEG1*FLOTTANT Q1*FLOTTANT ;
  24308. P1 = R1 0. Z1 ;
  24309. *
  24310. LIG1 = P0 D 1 P1 ;
  24311. *
  24312. *---- boucle sur les I-1 autres lignes du tableau
  24313. REPETER BOUC1 (I-2) ;
  24314. ACQU R1*FLOTTANT Z1*FLOTTANT DPSI1*FLOTTANT AEFF10*FLOTTANT DDPSI1*FLOTTANT PLEG1*FLOTTANT Q1*FLOTTANT ;
  24315. P1 = R1 0. Z1 ;
  24316. LIG1 = LIG1 D 1 P1 ;
  24317. FIN BOUC1 ;
  24318. *
  24319. *---- calcul des angles d'incidences
  24320. TAB1.<MAILLAGE_B = LIG1 ;
  24321. BR BZ BPHI = @MAGNB TAB1 ;
  24322. *
  24323. PHI = ATG (COOR 2 TAB1.<MAILLAGE_B) (COOR 1 TAB1.<MAILLAGE_B) ;
  24324. *AM*11/09/01*BX = BR * (COS PHI) + (BPHI * (SIN PHI));
  24325. *AM*11/09/01*BY = BR * (SIN PHI) - (BPHI * (COS PHI));
  24326. BX = BR * (COS PHI) - (BPHI * (SIN PHI));
  24327. BY = BR * (SIN PHI) + (BPHI * (COS PHI));
  24328. *
  24329. *---- Calcul des cosinus
  24330. B_NORM = ((BX*BX) + (BY*BY) + (BZ*BZ))**0.5 ;
  24331. COSR0 = BR / B_NORM ;
  24332. COSZ0 = BZ / B_NORM ;
  24333. COSP0 = BPHI / B_NORM ;
  24334. *
  24335. TITRE '@VERANG : COSINUS OF THE ANGLE BETWEEN b AND r AXIS' ;
  24336. EVOL1 = EVOL ROUG CHPO COSR0 LIG1 ;
  24337. DESS EVOL1 ;
  24338. LIST EVOL1 ;
  24339. *
  24340. TITRE '@VERANG : COSINUS OF THE ANGLE BETWEEN b AND z AXIS' ;
  24341. EVOL1 = EVOL ROUG CHPO COSZ0 LIG1 ;
  24342. DESS EVOL1 ;
  24343. LIST EVOL1 ;
  24344. *
  24345. TITRE '@VERANG : COSINUS OF THE ANGLE BETWEEN b AND phi AXIS' ;
  24346. EVOL1 = EVOL ROUG CHPO COSP0 LIG1 ;
  24347. DESS EVOL1 ;
  24348. LIST EVOL1 ;
  24349. *
  24350. MESS '---------------------------------> exiting @VERANG';
  24351. *
  24352. FINPROC ;
  24353.  
  24354. DEBPROC @VISIN TAB1*TABLE ;
  24355. *
  24356. *****************************************************************
  24357. * Procedure de visualisation de l'objet modelise positionne par *
  24358. * rapport au plasma. Cette procedure ne fonctionne qu'en 3D. *
  24359. * Alain MOAL (Aout 1995) *
  24360. *****************************************************************
  24361. *
  24362. OPTI ECHO 0 ;
  24363. MESS '---------------------------------> calling @VISIN';
  24364. *
  24365. *--------------- VARIABLES D'ENTREE :
  24366. MAIL0 = TAB1.<MAILLAGE ;
  24367. CP = TAB1.'CENTRE_PLASMA' ;
  24368. PT = TAB1.'PT_TGPLASMA' ;
  24369. THETA0 = TAB1.<THETA0 ;
  24370. RHO0 = TAB1.<RHO0 ;
  24371. RP = TAB1.<RP ;
  24372. *------------------------------------
  24373. *
  24374. SI (NON ((VALEUR DIME) EGA 3)) ;
  24375. ERRE '>>>> @VISIN only works on 3D geometries' ;
  24376. FINSI ;
  24377. *
  24378. *---- creation d'une nouvelle geometrie MAIL0V dans le repere local
  24379. *---- - l'origine O est placee au point tangent au plasma
  24380. *---- - l'axe OY est dirige vers le centre du plasma
  24381. *
  24382. VECT0 = CP MOINS PT ;
  24383. *
  24384. *---- verification de la valeur du petit rayon du plasma
  24385. RHO0 = NORM VECT0 ;
  24386. *---- verification que cette valeur est la meme que celle de TAB1.<RHO0
  24387. SI (EXISTE TAB1 <RHO0) ;
  24388. SI ((ABS ((RHO0 - TAB1.<RHO0)/RHO0)) > 1.E-4) ;
  24389. MESS '>>>> The computed value of the plasma radius is not';
  24390. MESS '>>>> the same as the given one in TAB1.<RHO0.';
  24391. MESS '>>>> You must check the coordinates of the CENTRE_PLASMA.';
  24392. ERRE ' >>>> ERROR in @VICIN' ;
  24393. FINSI ;
  24394. FINSI ;
  24395. *
  24396. VX = COOR 1 VECT0 ;
  24397. VY = COOR 2 VECT0 ;
  24398. VZ = COOR 3 VECT0 ;
  24399. P1 = 0. 0. 0. ;
  24400. P2 = 0. 0. 1. ;
  24401. VTRANS = PT MOINS P1 ;
  24402. SI (VY EGA 0.) ;
  24403. SI (VX EGA 0.) ;
  24404. ANG1 = 0. ;
  24405. FINSI ;
  24406. SI (VX > 0.) ;
  24407. ANG1 = 90. ;
  24408. FINSI ;
  24409. SI (VX < 0.) ;
  24410. ANG1 = -90. ;
  24411. FINSI ;
  24412. SINON ;
  24413. ANG1 = ATG VX VY ;
  24414. FINSI ;
  24415. *
  24416. MAIL0V = (MAIL0 MOINS VTRANS) TOUR ANG1 P1 P2 ;
  24417. *
  24418. VX1 = VX * (COS ANG1) - (VY * (SIN ANG1)) ;
  24419. VY1 = VX * (SIN ANG1) + (VY * (COS ANG1)) ;
  24420. VZ1 = VZ ;
  24421. *
  24422. SI (VY1 EGA 0.) ;
  24423. SI (VZ1 EGA 0.) ;
  24424. ANG2 = 0. ;
  24425. FINSI ;
  24426. SI (VZ1 > 0.) ;
  24427. ANG2 = -90. ;
  24428. FINSI ;
  24429. SI (VZ1 < 0.) ;
  24430. ANG2 = 90. ;
  24431. FINSI ;
  24432. SINON ;
  24433. ANG2 = -1.* (ATG VZ1 VY1) ;
  24434. FINSI ;
  24435. *
  24436. P1 = 0. 0. 0. ;
  24437. P2 = 1. 0. 0. ;
  24438. MAIL0V = MAIL0V TOUR ANG2 P1 P2 ;
  24439. *
  24440. *---- creation des axes du repere local :
  24441. *---- - l'origine O est placee au point tangent au plasma
  24442. *---- - l'axe OY est dirige vers le centre du plasma
  24443. *---- avec OX en bleu, OY en blanc, OZ en rouge
  24444. DENS 0.1 ;
  24445. OB1 = 0. 0. 0. ;
  24446. OB2 = .1 0. 0. ;
  24447. OB3 = 0. .1 0. ;
  24448. OB4 = 0. 0. .1 ;
  24449. LX = (D OB2 OB1) COUL BLEU ;
  24450. LY = (D OB3 OB1) COUL BLAN ;
  24451. LZ = (D OB4 OB1) COUL ROUG ;
  24452. MAIL0V = MAIL0V ET LX ET LY ET LZ ;
  24453. *TRACE (1000. -500. 1000.) FACE CACH MAIL0V ;
  24454. *
  24455. * ---- visualisation de la structure etudiee dans le tore
  24456. ABS1 = RHO0 * (SIN THETA0) * -1. ;
  24457. ABS2 = RHO0 * (COS THETA0) + RHO0 ;
  24458. ABS3 = RP * (COS THETA0) + RHO0 ;
  24459. ABS4 = RP * (SIN THETA0) ;
  24460. ABS5 = RHO0 * (SIN THETA0) ;
  24461. ABS6 = RHO0 * (COS(70.+THETA0)) + RHO0 ;
  24462. ABS7 = RHO0 * (SIN(70.+THETA0)) ;
  24463. ABS8 = RHO0 * (COS(70.-THETA0)) + RHO0 ;
  24464. ABS9 = RHO0 * (SIN(70.-THETA0)) * -1. ;
  24465. *
  24466. CPLASMA = 0. RHO0 0. ;
  24467. CTORE = 0. ABS2 ABS4 ;
  24468. CAUX1 = 0. ABS6 ABS7 ;
  24469. CAUX2 = 0. ABS8 ABS9 ;
  24470. CAUX3 = 0. ABS2 ABS5 ;
  24471. *
  24472. LIGPLAS = (CER3 OB1 CAUX1 CAUX2) ET (CER3 CAUX1 CAUX2 OB1) COUL ROSE ;
  24473. MAIL0V = MAIL0V ET LX ET LY ET LZ ET LIGPLAS ;
  24474. *TRACE (1000. -500. 1000.) FACE CACH MAIL0V;
  24475. *
  24476. * ----
  24477. MENAGE ;
  24478. ANGROT1 = -1.* THETA0 ;
  24479. VECT1 = 0. (-1.*RHO0*(COS THETA0) - RP) (RHO0*(SIN THETA0)) ;
  24480. MAIL0V = (MAIL0V TOUR ANGROT1 OB1 OB2) PLUS VECT1 ;
  24481. MAIL0V = MAIL0V TOUR 90. OB1 OB4 ;
  24482. CP1 = RP 0. 0. ;
  24483. CP2 = 0. 0. 1. ;
  24484. LIGTORE = (CP1 D 1 OB1 D 1 CP2) COUL TURQ ;
  24485. MAIL0V = MAIL0V ET LIGTORE ;
  24486. MENAGE ;
  24487. *
  24488. *---- multiplication des aiguilles sur le plancher
  24489. *aig* MAIL0V = MAIL0V ET (MAIL0V TOUR 0.7 OB1 OB4)
  24490. *aig* ET (MAIL0V TOUR 1.4 OB1 OB4)
  24491. *aig* ET (MAIL0V TOUR 2.1 OB1 OB4)
  24492. *aig* ET (MAIL0V TOUR 2.8 OB1 OB4) ;
  24493. *aig* MENAGE ;
  24494. *aig* MAIL0V = MAIL0V ET (MAIL0V TOUR 3.5 OB1 OB4) ;
  24495. *aig* MENAGE ;
  24496. *
  24497. TITRE 'POSITION OF THE MODELISED STRUCTURE IN THE TORE' ;
  24498. TRACE (0. -1000. 0.) FACE CACH MAIL0V ;
  24499. MESS '---------------------------------> exiting @VISIN';
  24500. FINPROC ;
  24501. DEBPROC @VISIN TAB1*TABLE ;
  24502. *
  24503. *****************************************************************
  24504. * Procedure de visualisation de l'objet modelise positionne par *
  24505. * rapport au plasma. Cette procedure ne fonctionne qu'en 3D. *
  24506. * Alain MOAL (Aout 1995) *
  24507. *****************************************************************
  24508. *
  24509. OPTI ECHO 0 ;
  24510. MESS '---------------------------------> calling @VISIN';
  24511. *
  24512. *--------------- VARIABLES D'ENTREE :
  24513. MAIL0 = TAB1.<MAILLAGE ;
  24514. CP = TAB1.'CENTRE_PLASMA' ;
  24515. PT = TAB1.'PT_TGPLASMA' ;
  24516. THETA0 = TAB1.<THETA0 ;
  24517. RHO0 = TAB1.<RHO0 ;
  24518. RP = TAB1.<RP ;
  24519. *------------------------------------
  24520. *
  24521. SI (NON ((VALEUR DIME) EGA 3)) ;
  24522. ERRE '>>>> @VISIN only works on 3D geometries' ;
  24523. FINSI ;
  24524. *
  24525. *---- creation d'une nouvelle geometrie MAIL0V dans le repere local
  24526. *---- - l'origine O est placee au point tangent au plasma
  24527. *---- - l'axe OY est dirige vers le centre du plasma
  24528. *
  24529. VECT0 = CP MOINS PT ;
  24530. *
  24531. *---- verification de la valeur du petit rayon du plasma
  24532. RHO0 = NORM VECT0 ;
  24533. *---- verification que cette valeur est la meme que celle de TAB1.<RHO0
  24534. SI (EXISTE TAB1 <RHO0) ;
  24535. SI ((ABS ((RHO0 - TAB1.<RHO0)/RHO0)) > 1.E-4) ;
  24536. MESS '>>>> The computed value of the plasma radius is not';
  24537. MESS '>>>> the same as the given one in TAB1.<RHO0.';
  24538. MESS '>>>> You must check the coordinates of the CENTRE_PLASMA.';
  24539. ERRE ' >>>> ERROR in @VISIN' ;
  24540. FINSI ;
  24541. FINSI ;
  24542. *
  24543. VX = COOR 1 VECT0 ;
  24544. VY = COOR 2 VECT0 ;
  24545. VZ = COOR 3 VECT0 ;
  24546. P1 = 0. 0. 0. ;
  24547. P2 = 0. 0. 1. ;
  24548. VTRANS = PT MOINS P1 ;
  24549. SI (VY EGA 0.) ;
  24550. SI (VX EGA 0.) ;
  24551. ANG1 = 0. ;
  24552. FINSI ;
  24553. SI (VX > 0.) ;
  24554. ANG1 = 90. ;
  24555. FINSI ;
  24556. SI (VX < 0.) ;
  24557. ANG1 = -90. ;
  24558. FINSI ;
  24559. SINON ;
  24560. ANG1 = ATG VX VY ;
  24561. FINSI ;
  24562. *
  24563. MAIL0V = (MAIL0 MOINS VTRANS) TOUR ANG1 P1 P2 ;
  24564. *
  24565. VX1 = VX * (COS ANG1) - (VY * (SIN ANG1)) ;
  24566. VY1 = VX * (SIN ANG1) + (VY * (COS ANG1)) ;
  24567. VZ1 = VZ ;
  24568. *
  24569. SI (VY1 EGA 0.) ;
  24570. SI (VZ1 EGA 0.) ;
  24571. ANG2 = 0. ;
  24572. FINSI ;
  24573. SI (VZ1 > 0.) ;
  24574. ANG2 = -90. ;
  24575. FINSI ;
  24576. SI (VZ1 < 0.) ;
  24577. ANG2 = 90. ;
  24578. FINSI ;
  24579. SINON ;
  24580. ANG2 = -1.* (ATG VZ1 VY1) ;
  24581. FINSI ;
  24582. *
  24583. P1 = 0. 0. 0. ;
  24584. P2 = 1. 0. 0. ;
  24585. MAIL0V = MAIL0V TOUR ANG2 P1 P2 ;
  24586. *
  24587. *---- creation des axes du repere local :
  24588. *---- - l'origine O est placee au point tangent au plasma
  24589. *---- - l'axe OY est dirige vers le centre du plasma
  24590. *---- avec OX en bleu, OY en blanc, OZ en rouge
  24591. DENS 0.1 ;
  24592. OB1 = 0. 0. 0. ;
  24593. OB2 = .1 0. 0. ;
  24594. OB3 = 0. .1 0. ;
  24595. OB4 = 0. 0. .1 ;
  24596. LX = (D OB2 OB1) COUL BLEU ;
  24597. LY = (D OB3 OB1) COUL BLAN ;
  24598. LZ = (D OB4 OB1) COUL ROUG ;
  24599. MAIL0V = MAIL0V ET LX ET LY ET LZ ;
  24600. *TRACE (1000. -500. 1000.) FACE CACH MAIL0V ;
  24601. *
  24602. * ---- visualisation de la structure etudiee dans le tore
  24603. ABS1 = RHO0 * (SIN THETA0) * -1. ;
  24604. ABS2 = RHO0 * (COS THETA0) + RHO0 ;
  24605. ABS3 = RP * (COS THETA0) + RHO0 ;
  24606. ABS4 = RP * (SIN THETA0) ;
  24607. ABS5 = RHO0 * (SIN THETA0) ;
  24608. ABS6 = RHO0 * (COS(70.+THETA0)) + RHO0 ;
  24609. ABS7 = RHO0 * (SIN(70.+THETA0)) ;
  24610. ABS8 = RHO0 * (COS(70.-THETA0)) + RHO0 ;
  24611. ABS9 = RHO0 * (SIN(70.-THETA0)) * -1. ;
  24612. *
  24613. CPLASMA = 0. RHO0 0. ;
  24614. CTORE = 0. ABS2 ABS4 ;
  24615. CAUX1 = 0. ABS6 ABS7 ;
  24616. CAUX2 = 0. ABS8 ABS9 ;
  24617. CAUX3 = 0. ABS2 ABS5 ;
  24618. *
  24619. LIGPLAS = (CER3 OB1 CAUX1 CAUX2) ET (CER3 CAUX1 CAUX2 OB1) COUL ROSE ;
  24620. MAIL0V = MAIL0V ET LX ET LY ET LZ ET LIGPLAS ;
  24621. *TRACE (1000. -500. 1000.) FACE CACH MAIL0V;
  24622. *
  24623. * ----
  24624. MENAGE ;
  24625. ANGROT1 = -1.* THETA0 ;
  24626. VECT1 = 0. (-1.*RHO0*(COS THETA0) - RP) (RHO0*(SIN THETA0)) ;
  24627. MAIL0V = (MAIL0V TOUR ANGROT1 OB1 OB2) PLUS VECT1 ;
  24628. MAIL0V = MAIL0V TOUR 90. OB1 OB4 ;
  24629. CP1 = RP 0. 0. ;
  24630. CP2 = 0. 0. 1. ;
  24631. LIGTORE = (CP1 D 1 OB1 D 1 CP2) COUL TURQ ;
  24632. MAIL0V = MAIL0V ET LIGTORE ;
  24633. MENAGE ;
  24634. *
  24635. *---- multiplication des aiguilles sur le plancher
  24636. *aig* MAIL0V = MAIL0V ET (MAIL0V TOUR 0.7 OB1 OB4)
  24637. *aig* ET (MAIL0V TOUR 1.4 OB1 OB4)
  24638. *aig* ET (MAIL0V TOUR 2.1 OB1 OB4)
  24639. *aig* ET (MAIL0V TOUR 2.8 OB1 OB4) ;
  24640. *aig* MENAGE ;
  24641. *aig* MAIL0V = MAIL0V ET (MAIL0V TOUR 3.5 OB1 OB4) ;
  24642. *aig* MENAGE ;
  24643. *
  24644. TITRE '@VISIN : MODELISED STRUCTURE IN THE TORE' ;
  24645. TRACE (0. -1000. 0.) FACE CACH MAIL0V ;
  24646. MESS '---------------------------------> exiting @VISIN';
  24647. FINPROC ;
  24648.  
  24649. DEBPROC @VISRES TAB1*TABLE ;
  24650. *
  24651. ******************************************************************
  24652. * Procedure de visualisation des resultats d'un calcul permanent *
  24653. * en 3D. Alain MOAL (aout-sept 1995) *
  24654. ******************************************************************
  24655. *
  24656. MESS '---------------------------------> calling @VISRES';
  24657. *
  24658. ITER = 1 ;
  24659. *--------------- VARIABLES D'ENTREE :
  24660. MAIL0 = TAB1.<MAILLAGE ;
  24661. TEMP = TAB1.TEMPERATURE ;
  24662. LIGCONV = TAB1.LFLUX_CONV_DESS ;
  24663. SURFCONV = TAB1.LFLUX_CONV ;
  24664. SURFEXTE = TAB1.LFLUX_EXTE ;
  24665. TE1 = TAB1.ITER ;
  24666. VTETA1 = TAB1.RESUTHER.'VALEUR_TETA'.ITER ;
  24667. HCONV1 = TAB1.RESUTHER.COEFECHANGE.ITER ;
  24668. PROFIL0 = TAB1.V_VPAT1 ;
  24669. FLU0 = EXTR TAB1.LIS_FLUX ITER;
  24670. MODEL0 = TAB1.MODELF ;
  24671. LIG0 = TAB1.LFLUX_EXTE_DESS ;
  24672. MAXSOFL = TAB1.MAX_SOFL ;
  24673. DMAQ0 = TAB1.D_MAQUETTE ;
  24674. NX = TAB1.C_COTETF1 ;
  24675. NY = TAB1.C_SITETF1 ;
  24676. NZ = TAB1.C_COS3F1 ;
  24677. VOLMAT1 = TAB1.ZONE_MAT.1 ;
  24678. VOLMAT2 = TAB1.ZONE_MAT.2 ;
  24679. VOLMAT3 = TAB1.ZONE_MAT.3 ;
  24680. ANGINCI = TAB1.<ANGINCI;
  24681. *TEST*VBVN = TAB1.<VBVN ;
  24682. SI ((DIME TAB1.<POINT_COUPE) EGA 3) ;
  24683. P1 = TEXT (EXTR TAB1.<POINT_COUPE 1) ;
  24684. P2 = TEXT (EXTR TAB1.<POINT_COUPE 2) ;
  24685. P3 = TEXT (EXTR TAB1.<POINT_COUPE 3) ;
  24686. SINON ;
  24687. ERRE '>>>> @VISRES : check TAB1.<POINT_COUPE' ;
  24688. FINSI ;
  24689. SI ((VALEUR DIME) EGA 3) ;
  24690. OEIL0 = TAB1.VIEW_P ;
  24691. SINON ;
  24692. ERRE '>>>> @VISRES only works on 3D geometries' ;
  24693. FINSI ;
  24694. *------------------------------------
  24695. *
  24696. *---- Table de visualisation
  24697. TAB2 = TABLE ;
  24698. TAB2.1 = 'MARQ CROI REGU MOT TITR FLUX' ;
  24699. TAB2.2 = 'MARQ TRIA REGU MOT TITR TEMPERATURE' ;
  24700. *
  24701. SI ((VALEUR DIME) NEG 3) ;
  24702. ERRE '>>>> @VISRES only works on 3D modelisations';
  24703. FINSI ;
  24704. *
  24705. FLU1 = FLU0 * PROFIL0 ;
  24706. *
  24707. *---- Trace du flux incident, de la temperature et de l'angle d'incidence
  24708. *---- le long d'une ligne en fonction de l'abscisse curviligne
  24709. XM = COOR 1 LIG0 ;
  24710. LIG2 = CHAN SEG2 LIG0 ;
  24711. XCUR = EXTR (EVOL CHPO XM SCAL (INVE LIG0)) ABSC ;
  24712. CHXCUR = MANU CHPO (INVE LIG2) 1 SCAL XCUR ;
  24713. FLUXI = NOMC SCAL FLU1 ;
  24714. TEMP1 = NOMC SCAL TEMP ;
  24715. TITRE ' @VISRES : INCIDENT FLUX (W/m2) AND TEMPERATURE (1.E-4*C)';
  24716. EVFLUI = EVOL JAUN CHPO FLUXI SCAL LIG0 ;
  24717. EVTEMI = EVOL ROUG CHPO (TEMP1*1.E4) SCAL LIG0 ;
  24718. DESSIN (EVFLUI ET EVTEMI) MIMA LEGE TAB2 ;
  24719. TITRE ' @VISRES : ANGLE BETWEEN B AND N (degree)';
  24720. EVANGI = EVOL JAUN CHPO ANGINCI SCAL LIG0 ;
  24721. DESSIN EVANGI MIMA ;
  24722. *TEST*TITRE ' @VISRES : VBVN ';
  24723. *TEST*EVVBVN = EVOL JAUN CHPO VBVN SCAL LIG0 ;
  24724. *TEST*DESSIN EVVBVN MIMA ;
  24725. *
  24726. *---- Trace de l'evolution du flux de convection le long d'une ligne
  24727. VTETA0 = REDU (EXCO 'T' TE1) LIGCONV ;
  24728. SI (EGA (TYPE VTETA1) 'CHPOINT ');
  24729. VTETA = EXCO 'T' VTETA1 ;
  24730. SINON ;
  24731. VTETA = VTETA1 ;
  24732. FINSI ;
  24733. HCONV = EXCO 'H' HCONV1 ;
  24734. *
  24735. *---- flux de convection sur la ligne et temperatures sur la ligne
  24736. FLUCONV = HCONV * (VTETA0 - VTETA) ;
  24737. TITRE '@VISRES : WALL FLUX (W/m2) AND WALL TEMPERATURE (1.E-5*C)' ;
  24738. EVFLUC = EVOL VERT CHPO FLUCONV SCAL LIGCONV ;
  24739. EVTEMC = EVOL TURQ CHPO (TEMP1*1.E5) SCAL LIGCONV ;
  24740. DESSIN (EVFLUC ET EVTEMC) MIMA LEGE TAB2 ;
  24741. *
  24742. *---- temperatures sur la ligne
  24743. *TITRE '@VISRES : WALL TEMPERATURE (C)' ;
  24744. *DESSIN (EVOL TURQ CHPO TEMP1 SCAL LIGCONV) MIMA ;
  24745. *
  24746. *---- flux de convection sur la surface de convection
  24747. FLUCONV0 = HCONV * (TE1 - VTETA) ;
  24748. *
  24749. *---- Calcul du facteur de concentration et de la puissance extraite
  24750. FACT0 = (MAXI FLUCONV0) / (MAXI FLU1);
  24751. FLUINT1 = FLUX MODEL0 FLU1 ;
  24752. FLUMOY = (MAXI(RESU FLUINT1)) / (MESU SURFEXTE) ;
  24753. PUI1 = MAXI(RESU FLUINT1) ;
  24754. *
  24755. *---- Trace en coupe des isovaleurs de temperature et des vecteurs flux
  24756. *---- incident et de convection
  24757. CHPX = EXCO SCAL (FLU1 * NX) UX ;
  24758. CHPY = EXCO SCAL (FLU1 * NY) UY ;
  24759. CHPZ = EXCO SCAL (FLU1 * NZ) UZ ;
  24760. CHPT = @ET (@ET CHPX CHPY) CHPZ ;
  24761. AMPLV1 = 10. * DMAQ0 / (2. * MAXSOFL) ;
  24762. VECFLUI = @VECADA CHPT (-1. * AMPLV1) 'ROUGE' ;
  24763. *FX = FLU1 * NX;
  24764. *FY = FLU1 * NY;
  24765. *FZ = FLU1 * NZ;
  24766. *VECFLUI = @CVECT FX FY FZ SURFEXTE VERT ;
  24767. TITRE '@VISRES : ISOTHERM IN SECTION' ;
  24768. TRAC OEIL0 COUPE P1 P2 P3 TEMP MAIL0;
  24769. *
  24770. *---- Trace des isovaleurs de temperature sans le maillage
  24771. TITRE '@VISRES : ISOTHERM, CONVECTED POWER 'PUI1' W';
  24772. SI (EGA (VALEUR ELEM) 'CUB8') ;
  24773. ARET1 = ARETE VOLMAT1 ;
  24774. ARET2 = ARETE VOLMAT2 ;
  24775. ARET3 = ARETE VOLMAT3 ;
  24776. SINON ;
  24777. ARET1 = ARETE VOLMAT1 40.;
  24778. ARET2 = ARETE VOLMAT2 40.;
  24779. ARET3 = ARETE VOLMAT3 40.;
  24780. FINSI ;
  24781. ARET0 = ARET1 ET ARET2 ET ARET3 ;
  24782. TRAC CACH OEIL0 7 TEMP MAIL0 ARET0 ;
  24783. TRAC CACH OEIL0 TEMP MAIL0 ARET0 ;
  24784. *
  24785. *---- Messages
  24786. MESS ' HIGHEST WALL TEMPERATURE (C)..........: ' (MAXI VTETA0);
  24787. MESS ' LOWEST WALL TEMPERATURE (C)...........: ' (MINI VTETA0);
  24788. MESS ' MEAN INCIDENT FLUX (W/m2).............: ' FLUMOY ;
  24789. MESS ' HIGHEST INCIDENT FLUX (W/m2)..........: ' (MAXI FLU1) ;
  24790. MESS ' LOWEST INCIDENT FLUX (W/m2)...........: ' (MINI FLU1) ;
  24791. MESS ' HIGHEST CONVECTION FLUX (W/m2)........: ' (MAXI FLUCONV0);
  24792. MESS ' LOWEST CONVECTION FLUX (W/m2).........: ' (MINI FLUCONV0);
  24793. MESS ' CONCENTRATION FACTOR .................: ' FACT0 ;
  24794. *
  24795. MESS '---------------------------------> exiting @VISRES';
  24796. FINPROC ;
  24797. **** @VNORM3D
  24798. DEBPROC @VNORM3D <MAIL1*MAILLAGE <MAILD_1*MAILLAGE NIVEAU1/ENTIER;
  24799. *
  24800. * !!! R. MITTEAU !!! attention, procedure standard
  24801. *
  24802. * un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
  24803. * pour les mises a jour
  24804. *
  24805. SI (NON (EXISTE NIVEAU1));
  24806. MESS '---------------------------------> calling @VNORM3D';
  24807. SINON;
  24808. SI (NIVEAU1 >EG 4);
  24809. MESS '---------------------------------> calling @VNORM3D';
  24810. FINSI;
  24811. FINSI;
  24812. SI (EGA (VALE MODE) 'AXIS') ;
  24813. FX = 'FR' ;
  24814. FY = 'FZ' ;
  24815. FINSI ;
  24816. MODL1 = MODE <MAIL1 'MECANIQUE' 'ELASTIQUE' ;
  24817. FPREF1 = PRESSION MASS MODL1 -1.E5 <MAILD_1 ;
  24818. XFF1 = ( EXCO FX FPREF1 'SCAL' ) ;
  24819. YFF1 = ( EXCO FY FPREF1 'SCAL' ) ;
  24820. V_DIM1 = VALEUR 'DIME' ;
  24821. SI ( V_DIM1 EGA 2) ;
  24822. NORMDP1 = ( (XFF1**2) + (YFF1**2) )**0.5;
  24823. >COSDIR1 = XFF1 / NORMDP1 ;
  24824. >COSDIR2 = YFF1 / NORMDP1 ;
  24825. >COSDIR3 = >COSDIR1 * 0. ;
  24826. SINON ;
  24827. ZFF1 = ( EXCO FZ FPREF1 'SCAL' ) ;
  24828. NORMDP1 = ( (XFF1**2) + (YFF1**2) + (ZFF1**2) )**0.5 ;
  24829. >COSDIR1 = XFF1 / NORMDP1 ;
  24830. >COSDIR2 = YFF1 / NORMDP1 ;
  24831. >COSDIR3 = ZFF1 / NORMDP1 ;
  24832. FPREF2 = @ET ( MANU CHPO <MAIL1 3 FX 0. FY 0. FZ 0.) FPREF1 ;
  24833. CH_1 = CHAN 'CHAM' FPREF2 MODL1 'GRAVITE';
  24834. CHPO1 = REDU <MAILD_1 (CHAN 'CHPO' MODL1 CH_1) ;
  24835. SENS1 = PSCAL FPREF1 CHPO1 (MOTS FX FY FZ) (MOTS FX FY FZ) ;
  24836.  
  24837. MASQ1 = SENS1 MASQUE INFERIEUR 0. ;
  24838. MASQ2 = SENS1 MASQUE EGSUPE 0. ;
  24839. MASQ3 = @ET (-1. * MASQ1) MASQ2 ;
  24840.  
  24841. >COSDIR1 = >COSDIR1 * MASQ3 ;
  24842. >COSDIR2 = >COSDIR2 * MASQ3 ;
  24843. >COSDIR3 = >COSDIR3 * MASQ3 ;
  24844. FINSI ;
  24845.  
  24846. SI (NON (EXISTE NIVEAU1));
  24847. MESS '---------------------------------> exiting @VNORM3D';
  24848. SINON;
  24849. SI (NIVEAU1 >EG 4);
  24850. MESS '---------------------------------> exiting @VNORM3D';
  24851. FINSI;
  24852. FINSI;
  24853.  
  24854. FINPROC >COSDIR1 >COSDIR2 >COSDIR3 ;
  24855. **** @VNORMAL
  24856. DEBPROC VNORMAL <MAIL1*MAILLAGE <MAILD_1*MAILLAGE ;
  24857. MESS '---------------------------------> Entree dans VNORMAL ' ;
  24858. MODL1 = MODE <MAIL1 'MECANIQUE' 'ELASTIQUE' ;
  24859. FPREF1 = PRESSION MASS MODL1 1.E5 <MAILD_1 ;
  24860. XFF1 = ( EXCO FX FPREF1 'SCAL' ) * -1. ;
  24861. YFF1 = ( EXCO FY FPREF1 'SCAL' ) * -1. ;
  24862. >TETHA1 = ATG YFF1 ( XFF1 + 1.E-12) ;
  24863. >COS1 = ( COS >TETHA1 ) * 1. ;
  24864. >SIN1 = ( SIN >TETHA1 ) * 1. ;
  24865. MESS '---------------------------------> sortie de VNORMAL' ;
  24866. FINPROC >TETHA1 >COS1 >SIN1 ;
  24867.  
  24868.  
  24869. ***********************************************
  24870. * Test de ITRC *
  24871. * Alain MOAL - CS SI (Janvier 2004) *
  24872. ***********************************************
  24873. *
  24874. * --- options de calcul
  24875. *
  24876. opti echo 1 ;
  24877. opti elem cub8 ;
  24878. *opti trac x;
  24879.  
  24880. *+++++++++++++++++++++++++++++++++++++*
  24881. * MAILLAGE *
  24882. *+++++++++++++++++++++++++++++++++++++*
  24883. *
  24884. *----------------------------*
  24885. * MAILLAGE OMBRE *
  24886. *----------------------------*
  24887.  
  24888. * parametres de la geometrie:
  24889. d1 = 50.e-3;
  24890. d2 = 40.e-3;
  24891. d3 = 10.e-3;
  24892. dist1 = 0.05;
  24893. dist2 = 0.01;
  24894. *
  24895. n1 = 10;
  24896. n2 = 5;
  24897. n3 = 1;
  24898. *
  24899. * creation des points
  24900. *
  24901. OEIL0 = 1000. -1000. 1000. ;
  24902. v1 = 0. (-1.*d1) 0. ;
  24903. v2 = 0. 0. d2 ;
  24904. a1 = 0. 2.4 (-0.72) ;
  24905. a2 = a1 plus v1 ;
  24906. a3 = a2 plus v2 ;
  24907. a4 = a3 moins v1 ;
  24908. rep1 = ((0. 0. 0.) d 1 (3. 0. 0.)) et ((0. 0. 0.) d 1 (0. 3. 0.)) et ((0. 0. 0.) d 1 (0. 0. 3.));
  24909. *
  24910. * creation des lignes
  24911. *
  24912. l1 = a1 d n1 a2 ;
  24913. l2 = a2 d n2 a3 ;
  24914. l3 = a3 d n1 a4 ;
  24915. l4 = a4 d n2 a1 ;
  24916. *
  24917. * creation des surfaces
  24918. *
  24919. st_ombre = daller l1 l2 l3 l4 plan ;
  24920. *trac st_ombre ;
  24921. *
  24922. * creation des volumes
  24923. *
  24924. vt_ombre = st_ombre volu n3 tran ((-1.*d3) 0. 0.);
  24925. *trac v_ombre ;
  24926. *
  24927. *--------------------*
  24928. * MAILLAGE OMBRANT
  24929. *--------------------*
  24930. *
  24931. vect1 = dist1 0. dist2 ;
  24932. s_ombre = st_ombre plus vect1 ;
  24933. v_ombre = s_ombre volu n3 tran (d3 0. 0.);
  24934. si graph;
  24935. trac (((st_ombre et s_ombre) coul roug) et vt_ombre et v_ombre et rep1);
  24936. finsi;
  24937.  
  24938. * --- Calcul de l'ombrage
  24939. *
  24940. tab1 = table ;
  24941. *
  24942. tab1.<ITRAC = vrai ;
  24943. tab1.<TYPE_CALCUL = MOT 'AVEC_SHIFT_AVEC_RIPPLE' ;
  24944. *
  24945. *---- position dans la machine
  24946. *
  24947. tab1.<CENTRE_TORE = (0. 0. 0.) ;
  24948.  
  24949. tab1.<POINT_SUR_AXE_TORE = (0. 0. 2.) ;
  24950.  
  24951. lig1 = tab1.<CENTRE_TORE d 1 tab1.<POINT_SUR_AXE_TORE;
  24952.  
  24953. tab1.<POINT_SUR_OBJET = a1 ;
  24954. tab1.<ANG_PHI0 = 0. ;
  24955. tab1.<RP = 2.40 ;
  24956. tab1.<RHO0 = 720.E-3 ;
  24957. tab1.<HP = 0. ;
  24958.  
  24959. *---- parametres plasma
  24960. tab1.<IPLASMA = -1.2E6 ;
  24961. tab1.<INTENS = 1.1E3 ;
  24962. tab1.<LAMB = 0.0 ;
  24963. tab1.<LAMBQREF = 10.E-3 ;
  24964. *
  24965. * --- passage des maillages
  24966. *
  24967. tab1.<maillage = vt_ombre ;
  24968. tab1.lflux_exte = st_ombre ;
  24969. tab1.modelf = MODE vt_ombre thermique isotrope;
  24970.  
  24971. * remplissage de tab1
  24972.  
  24973. tab1.<S_OMBRE = st_ombre ;
  24974. tab1.<V_OMBRE_N = vt_ombre ;
  24975. tab1.<S_OMBRE_N = st_ombre ;
  24976.  
  24977. tab1.<S_OMBRANT = s_ombre ;
  24978. tab1.<V_OMBRANT_N = v_ombre ;
  24979. tab1.<S_OMBRANT_N = s_ombre ;
  24980.  
  24981. tab1.<METHODE_REMONTEE = 1 ;
  24982. tab1.<DIST_SANS_TEST = 0.001 ;
  24983. tab1.<PAS_SANS_TEST = 0.001 ;
  24984. tab1.<DIST_AVEC_TEST = 0.1 ;
  24985. tab1.<PAS_AVEC_TEST = 0.005 ;
  24986.  
  24987. TAB1.<REMONTEE = TABLE ;
  24988. TAB1.<REMONTEE.<POINT = TABLE ;
  24989. TAB1.<REMONTEE.<POINT.1 = st_ombre POIN 40;
  24990. TAB1.<REMONTEE.<POINT.2 = st_ombre POIN 45 ;
  24991.  
  24992. @ombrage tab1;
  24993.  
  24994. TITRE 'LIGNES DE CHAMP' ;
  24995. si graph;
  24996. TRAC OEIL0 (st_ombre ET s_ombre ET TAB1.<REMONTEE.<LIGNE.1 ET TAB1.<REMONTEE.<LIGNE.2) ;
  24997.  
  24998. TITRE 'CONNECTION DISTANCE' ;
  24999. TRAC TAB1.<CHDIST st_ombre ;
  25000.  
  25001. TITRE 'OMBRE EN BLEU';
  25002. TRAC TAB1.<MASQOMB st_ombre ;
  25003. finsi;
  25004. *---- validation du resultat
  25005. PO1 = 0.0 2.37 -0.72 ;
  25006. PO2 = 0.0 2.365 -0.688 ;
  25007. VAL0 = EXTR TAB1.<CHDIST SCAL (st_ombre POIN PROC PO1) ;
  25008. VAL1 = EXTR TAB1.<CHDIST SCAL (st_ombre POIN PROC PO2) ;
  25009.  
  25010. SI (((VAL0 >EG 0.10099) ET (VAL0 &lt;EG 0.10101)) ET ((VAL1 >EG 0.050219) ET (VAL1 &lt;EG 0.050221)));
  25011. MESS 'RESULTAT CORRECT';
  25012. SINON ;
  25013. MESS 'RESULTAT INCORRECT'; erreur 5;
  25014. FINSI ;
  25015.  
  25016. *opti donn 5 ;
  25017. fin ;
  25018.  
  25019.  
  25020.  
  25021.  
  25022.  
  25023.  
  25024.  
  25025.  
  25026.  
  25027.  
  25028.  
  25029.  
  25030.  
  25031.  
  25032.  
  25033.  
  25034.  
  25035.  
  25036.  
  25037.  
  25038.  
  25039.  
  25040.  

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