Télécharger cfpflu.dgibi

Retour à la liste

Numérotation des lignes :

  1. optio debu 1;
  2. * fichier : cfpflu.dgibi
  3. ************************************************************************
  4. ************************************************************************
  5. OPTI ECHO 1 ;
  6. * repertoire des fichiers "divers"
  7. DIVERS = VENV 'CASTEM_DIVERS';
  8. *
  9.  
  10. **** @ACBLM
  11. DEBPROC @ACBLM VXL*CHPOINT VYL*CHPOINT VZL*CHPOINT TAB1*TABLE ;
  12. *
  13. ********************************************************************
  14. * Procedure de changement de base. On passe de la base cartesienne *
  15. * locale de l'objet modelise a la base cartesienne du maillage. L' *
  16. * axe Y de la base locale est dirige du point de tangence vers le *
  17. * centre du plasma. Alain MOAL (juillet-aout 1995) *
  18. ********************************************************************
  19. *
  20. *--------------- VARIABLES D'ENTREE :
  21. CP = TAB1.'CENTRE_PLASMA' ;
  22. PTG = TAB1.'PT_TGPLASMA' ;
  23. SI ((VALEUR DIME) EGA 2) ;
  24. SI (EXISTE TAB1 <PLAN) ;
  25. IPLAN = TAB1.<PLAN ;
  26. SINON ;
  27. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  28. FINSI ;
  29. FINSI ;
  30. *------------------------------------
  31. *
  32. VECT0 = CP MOINS PTG ;
  33. VX = COOR 1 VECT0 ;
  34. VY = COOR 2 VECT0 ;
  35. *
  36. *---- calcul de l'angle de rotation dans le plan XY
  37. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  38. ANG1 = 0. ;
  39. SINON ;
  40. ANG1 = -1.* (ATG VX VY) ;
  41. FINSI ;
  42. *
  43. SI ((VALEUR DIME) EGA 2) ;
  44. SI (EGA IPLAN 'PHICONS');
  45. * ---- Coupe 2D a Phi constant
  46. VXL1 = VZL ;
  47. VYL1 = VYL ;
  48. VZL1 = VXL * (-1.);
  49. * ---- rotation
  50. VXM = VXL1 * (COS ANG1) + (VYL1 * (-1.) * (SIN ANG1));
  51. VYM = VXL1 * (SIN ANG1) + (VYL1 * (COS ANG1)) ;
  52. VZM = VZL1 ;
  53. FINSI ;
  54. SI (EGA IPLAN 'THETACONS');
  55. * ---- Coupe 2D a Theta constant
  56. * ---- rotation
  57. VXM = VXL * (COS ANG1) + (VYL * (-1.) * (SIN ANG1)) ;
  58. VYM = VXL * (SIN ANG1) + (VYL * (COS ANG1)) ;
  59. VZM = VZL ;
  60. FINSI;
  61. SINON ;
  62. VZ = COOR 3 VECT0 ;
  63. *
  64. * ---- calcul de l'angle de rotation dans le plan Y1Z1
  65. VX1 = VX * (COS ANG1) + (VY * (SIN ANG1)) ;
  66. VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1)) ;
  67. VZ1 = VZ ;
  68. *
  69. SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
  70. ANG2 = 0. ;
  71. SINON ;
  72. ANG2 = ATG VZ1 VY1 ;
  73. FINSI ;
  74. *
  75. * ---- rotations
  76. VXL1 = VXL ;
  77. VYL1 = VYL * (COS ANG2) + (VZL * (-1.) * (SIN ANG2));
  78. VZL1 = VYL * (SIN ANG2) + (VZL * (COS ANG2)) ;
  79. *
  80. VXM = VXL1 * (COS ANG1) + (VYL1 * (-1.) * (SIN ANG1)) ;
  81. VYM = VXL1 * (SIN ANG1) + (VYL1 * (COS ANG1)) ;
  82. VZM = VZL1 ;
  83. FINSI ;
  84. FINPROC VXM VYM VZM ;
  85. **** @ACBML
  86. DEBPROC @ACBML VXM*CHPOINT VYM*CHPOINT VZM*CHPOINT TAB1*TABLE ;
  87. *
  88. **********************************************************************
  89. * Procedure de changement de base. On passe de la base cartesienne *
  90. * du maillage a la base cartesienne locale de l'objet modelise. L' *
  91. * axe Y est dirige du point de tangence vers le centre du plasma. *
  92. * Alain MOAL (juillet-aout 1995) *
  93. **********************************************************************
  94. *
  95. *--------------- VARIABLES D'ENTREE :
  96. CP = TAB1.'CENTRE_PLASMA' ;
  97. PTG = TAB1.'PT_TGPLASMA' ;
  98. SI ((VALEUR DIME) EGA 2) ;
  99. SI (EXISTE TAB1 <PLAN) ;
  100. IPLAN = TAB1.<PLAN ;
  101. SINON ;
  102. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  103. FINSI ;
  104. FINSI ;
  105. *------------------------------------
  106. *
  107. VECT0 = CP MOINS PTG ;
  108. VX = COOR 1 VECT0 ;
  109. VY = COOR 2 VECT0 ;
  110. *
  111. *---- calcul de l'angle de rotation dans le plan XY
  112. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  113. ANG1 = 0. ;
  114. SINON ;
  115. ANG1 = -1.* (ATG VX VY) ;
  116. FINSI ;
  117. *
  118. SI ((VALEUR DIME) EGA 2) ;
  119. * ---- rotation pour aligner l'axe Y avec VECT0
  120. SI (EGA IPLAN 'PHICONS');
  121. * ---- Coupe 2D a Phi constant
  122. VXL1 = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  123. VYL1 = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  124. VZL1 = VZM ;
  125. * ---- Coupe 2D a Phi constant
  126. VXL = VZL1 ;
  127. VYL = VYL1 ;
  128. VZL = VXL1 * (-1.);
  129. FINSI ;
  130. SI (EGA IPLAN 'THETACONS');
  131. * ---- Coupe 2D a Theta constant
  132. * ---- rotation
  133. VXL = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  134. VYL = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  135. VZL = VZM ;
  136. FINSI ;
  137. *
  138. SINON ;
  139. VZ = COOR 3 VECT0 ;
  140. * ---- rotation pour aligner l'axe Y avec VECT0
  141. VXM1 = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  142. VYM1 = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  143. VZM1 = VZM ;
  144. *
  145. VX1 = VX * (COS ANG1) + (VY * (SIN ANG1)) ;
  146. VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1)) ;
  147. VZ1 = VZ ;
  148. *
  149. * ---- calcul de l'angle de rotation dans le plan Y1Z1
  150. SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
  151. ANG2 = 0. ;
  152. SINON ;
  153. ANG2 = ATG VZ1 VY1 ;
  154. FINSI ;
  155. *
  156. VXL = VXM1 ;
  157. VYL = VYM1 * (COS ANG2) + (VZM1 * (SIN ANG2));
  158. VZL = VYM1 * (-1.) * (SIN ANG2) + (VZM1 * (COS ANG2));
  159. *
  160. FINSI ;
  161. *MESS '>>>> @CBMLV' ; LIST VXL ; LIST VYL ; LIST VZL ;
  162. FINPROC VXL VYL VZL ;
  163.  
  164. **** @ACRLM
  165. DEBPROC @ACRLM XL*CHPOINT YL*CHPOINT ZL*CHPOINT TAB1*TABLE ;
  166. *
  167. *******************************************************************
  168. * Procedure de changement de repere. On passe du repere cartesien *
  169. * local de l'objet modelise au repere cartesien du maillage. Le *
  170. * point de tangence au plasma est l'origine du repere local et *
  171. * l'axe Y est dirige vers le centre du plasma. *
  172. * Alain MOAL (juillet-aout 1995) *
  173. *******************************************************************
  174. *
  175. *--------------- VARIABLES D'ENTREE :
  176. CP = TAB1.'CENTRE_PLASMA' ;
  177. PTG = TAB1.'PT_TGPLASMA' ;
  178. SI ((VALEUR DIME) EGA 2) ;
  179. SI (EXISTE TAB1 <PLAN) ;
  180. IPLAN = TAB1.<PLAN ;
  181. SINON ;
  182. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  183. FINSI ;
  184. FINSI ;
  185. *------------------------------------
  186. *
  187. VECT0 = CP MOINS PTG ;
  188. VX = COOR 1 VECT0 ;
  189. VY = COOR 2 VECT0 ;
  190. *
  191. *---- calcul de l'angle de rotation dans le plan XY
  192. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  193. ANG1 = 0. ;
  194. SINON ;
  195. ANG1 = -1.* (ATG VX VY) ;
  196. FINSI ;
  197. *
  198. XPTG = COOR 1 PTG ;
  199. YPTG = COOR 2 PTG ;
  200. *
  201. SI ((VALEUR DIME) EGA 2) ;
  202. SI (EGA IPLAN 'PHICONS');
  203. * ---- Coupe 2D a Phi constant
  204. XL = ZL ;
  205. ZL = ZL * 0.;
  206. * ---- rotation
  207. XL1 = XL * (COS ANG1) + (YL * (-1.) * (SIN ANG1));
  208. YL1 = XL * (SIN ANG1) + (YL * (COS ANG1));
  209. FINSI;
  210. SI (EGA IPLAN 'THETACONS');
  211. * ---- Coupe 2D a Theta constant
  212. * ---- rotation
  213. XL1 = XL * (COS ANG1) + (YL * (-1.) * (SIN ANG1));
  214. YL1 = XL * (SIN ANG1) + (YL * (COS ANG1));
  215. FINSI;
  216. * ---- changement d'origine du repere
  217. XM = XL1 + XPTG ;
  218. YM = YL1 + YPTG ;
  219. ZM = YL1 * 0. ;
  220. SINON ;
  221. VZ = COOR 3 VECT0 ;
  222. ZPTG = COOR 3 PTG ;
  223. *
  224. * ---- calcul de l'angle de rotation dans le plan Y1Z1
  225. VX1 = VX * (COS ANG1) + (VY * (SIN ANG1)) ;
  226. VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1)) ;
  227. VZ1 = VZ ;
  228. *
  229. SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
  230. ANG2 = 0. ;
  231. SINON ;
  232. ANG2 = ATG VZ1 VY1 ;
  233. FINSI ;
  234. *
  235. * ---- rotations
  236. XL1 = XL ;
  237. YL1 = YL * (COS ANG2) + (ZL * (-1.) * (SIN ANG2)) ;
  238. ZL1 = YL * (SIN ANG2) + (ZL * (COS ANG2)) ;
  239. *
  240. XL2 = XL1 * (COS ANG1) + (YL1 * (-1.) * (SIN ANG1)) ;
  241. YL2 = XL1 * (SIN ANG1) + (YL1 * (COS ANG1)) ;
  242. ZL2 = ZL1 ;
  243. *
  244. * ---- changement d'origine du repere
  245. XM = XL2 + XPTG ;
  246. YM = YL2 + YPTG ;
  247. ZM = ZL2 + ZPTG ;
  248. FINSI ;
  249. FINPROC XM YM ZM ;
  250. **** @ACRML
  251. DEBPROC @ACRML XM*CHPOINT YM*CHPOINT ZM*CHPOINT TAB1*TABLE ;
  252. *
  253. *******************************************************************
  254. * Procedure de changement de repere. On passe du repere cartesien *
  255. * du maillage au repere cartesien local de l'objet modelise. Le *
  256. * point de tangence au plasma est l'origine de ce repere et l'axe *
  257. * l'axe Y final est dirige vers le centre du plasma. *
  258. * en 3D l'axe x initial doit etre l'axe toroidal *
  259. * en 2D cas PHICONS l'axe Z initial est l'axe toroidal *
  260. * en 2D cas THETACONS l'axe x initial est l'axe toroidal *
  261. * Alain MOAL (juillet-aout 1995) *
  262. *******************************************************************
  263. *
  264. *--------------- VARIABLES D'ENTREE :
  265. CP = TAB1.'CENTRE_PLASMA' ;
  266. PTG = TAB1.'PT_TGPLASMA' ;
  267. SI ((VALEUR DIME) EGA 2) ;
  268. SI (EXISTE TAB1 <PLAN) ;
  269. IPLAN = TAB1.<PLAN ;
  270. SINON ;
  271. ERRE '>>>> @CRMLC : TAB1.<PLAN n existe pas' ;
  272. FINSI ;
  273. FINSI ;
  274. *------------------------------------
  275. *
  276. VECT0 = CP MOINS PTG ;
  277. VX = COOR 1 VECT0 ;
  278. VY = COOR 2 VECT0 ;
  279. *
  280. *---- calcul de l'angle de rotation dans le plan XY
  281. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  282. ANG1 = 0. ;
  283. SINON ;
  284. ANG1 = -1.* (ATG VX VY) ;
  285. FINSI ;
  286. *
  287. XPTG = COOR 1 PTG ;
  288. YPTG = COOR 2 PTG ;
  289. *
  290. SI ((VALEUR DIME) EGA 2) ;
  291. * ---- changement d'origine du repere
  292. XM1 = XM - XPTG ;
  293. YM1 = YM - YPTG ;
  294. * ---- rotation pour aligner l'axe Y avec VECT0
  295. SI (EGA IPLAN 'PHICONS');
  296. * ---- Coupe 2D a Phi constant
  297. XL = XM1 * (COS ANG1) + (YM1 * (SIN ANG1));
  298. YL = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1));
  299. ZL = XM * 0. ;
  300. *
  301. ZL = XL ;
  302. XL = XL * 0.;
  303. FINSI;
  304. SI (EGA IPLAN 'THETACONS');
  305. * ---- Coupe 2D a Theta constant
  306. XL = XM1 * (COS ANG1) + (YM1 * (SIN ANG1));
  307. YL = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1));
  308. ZL = XM * 0. ;
  309. FINSI ;
  310. *
  311. SINON ;
  312. VZ = COOR 3 VECT0 ;
  313. ZPTG = COOR 3 PTG ;
  314. * ---- changement d'origine du repere
  315. XM1 = XM - XPTG ;
  316. YM1 = YM - YPTG ;
  317. ZM1 = ZM - ZPTG ;
  318. * ---- rotation pour aligner l'axe Y avec VECT0
  319. XM2 = XM1 * (COS ANG1) + (YM1 * (SIN ANG1)) ;
  320. YM2 = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1)) ;
  321. ZM2 = ZM1 ;
  322. *
  323. VX1 = VX * (COS ANG1) + (VY * (SIN ANG1)) ;
  324. VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1)) ;
  325. VZ1 = VZ ;
  326. *
  327. * ---- calcul de l'angle de rotation dans le plan Y1Z1
  328. SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
  329. ANG2 = 0. ;
  330. SINON ;
  331. ANG2 = ATG VZ1 VY1 ;
  332. FINSI ;
  333. *
  334. XL = XM2 ;
  335. YL = YM2 * (COS ANG2) + (ZM2 * (SIN ANG2)) ;
  336. ZL = YM2 * (-1.) * (SIN ANG2) + (ZM2 * (COS ANG2)) ;
  337. *
  338. FINSI ;
  339. *MESS '>>>> @CRMLC : XL' ; LIST XL ; LIST YL ; LIST ZL ;
  340. FINPROC XL YL ZL ;
  341.  
  342. **** @AMPLI
  343. DEBPROC @AMPLI XV*CHPOINT YV*CHPOINT ZV*CHPOINT VALDIM*ENTIER MAIL0*MAILLAGE ;
  344. *
  345. *************************************************************
  346. * Procedure d'adaptation du facteur d'amplification utilise *
  347. * pour visualiser un champ de vecteur sur une geometrie. *
  348. * Alain MOAL (juillet 1995) *
  349. *************************************************************
  350. *
  351. XM = COOR 1 MAIL0 ;
  352. YM = COOR 2 MAIL0 ;
  353. SI (VALDIM EGA 2) ;
  354. ZM = XM * 0. ;
  355. SINON ;
  356. ZM = COOR 3 MAIL0 ;
  357. FINSI ;
  358. *
  359. *---- norme du vecteur
  360. VECNORM = ((XV * XV) + (YV * YV) + (ZV * ZV))**0.5 ;
  361. *
  362. *---- calcul d'une longueur caracteristique du maillage
  363. LONGCAR1 = ABS ((MAXI XM) - (MINI XM)) ;
  364. LONGCAR2 = ABS ((MAXI YM) - (MINI YM)) ;
  365. LONGCAR3 = ABS ((MAXI ZM) - (MINI ZM)) ;
  366. *
  367. SI (VALDIM EGA 2) ;
  368. LONGCAR = MINI (PROG LONGCAR1 LONGCAR2) ;
  369. SINON ;
  370. LONGCAR = MINI (PROG LONGCAR1 LONGCAR2 LONGCAR3) ;
  371. FINSI ;
  372. *
  373. AMPLI0 = LONGCAR / (MAXI VECNORM) / 10.;
  374. *
  375. FINPROC AMPLI0 ;
  376. **** @ANADES
  377.  
  378. DEBPROC @ANADES TAB1*TABLE ;
  379. *
  380. *************************************************
  381. * Procedure (inspiree de @ANALY) permettant de *
  382. * descendre les lignes de champ et de calculer *
  383. * avec une methode analytique exacte les points *
  384. * d'intersection sur le plan de reference pour *
  385. * recuperer les valeurs du flux normalise. *
  386. * Alain MOAL (Fevrier 2001) *
  387. *************************************************
  388. *
  389. MESS '---------------------------------> calling @ANADES';
  390. *
  391. *--------------- VARIABLES D'ENTREE :
  392. S_OMBRE = TAB1.LFLUX_EXTE ;
  393. S_OMBRAN = TAB1.<MAILLAGE_FN ;
  394. CHSIGN1 = TAB1.<CHAMP_SIGNE ;
  395. PASB2 = TAB1.<LONGUEUR_PAS_AVEC_TEST ;
  396. DMAX2 = TAB1.<DISTANCE_AVEC_TEST ;
  397. NBPAS2 = TAB1.<NOMBRE_PAS_AVEC_TEST ;
  398. PASB1 = TAB1.<LONGUEUR_PAS_SANS_TEST ;
  399. DMAX1 = TAB1.<DISTANCE_SANS_TEST ;
  400. NBPAS1 = TAB1.<NOMBRE_PAS_SANS_TEST ;
  401. TOL1 = 1.e-9 ;
  402. *------------------------------------
  403. *
  404. * --- PASSAGE EN TRI3 POUR LA PROCEDURE @INTSEC
  405. si (DIME(S_OMBRAN ELEM 'TYPE') EGA 2) ;
  406. stri3 = elem s_ombran tri3 ;
  407. squa4 = elem s_ombran qua4 ;
  408. squtri3 = chan squa4 tri3 ;
  409. s_ombra2 = squtri3 et stri3 ;
  410. sinon ;
  411. s_ombra2 = chan s_ombran tri3 ;
  412. finsi ;
  413. *
  414. * --- CONSTRUCTION DU MAILLAGE DES POINTS A SUIVRE
  415. MAILPTS = MANU POI1 ((chan s_ombre poi1) poin init) ;
  416. TABPTS1 = table ;
  417. TABPTS1 . 1 = (chan s_ombre poi1) poin init ;
  418. npts = 1 ;
  419. tablig1 = table ;
  420.  
  421. * --- CREATION DES 3 CHMELEM DE COORDONNEES AUX ELEMENTS
  422. TAB1.<MAILLAGE = S_OMBRA2 ;
  423. *AM*27/01/04 @RMXYZ TAB1 ;
  424. @RMCOORO TAB1 ;
  425. * --- CALCUL DES NORMALES AUX ELEMENTS SUR LE MAILLAGE OMBRANT
  426. *AM*27/01/04 @AMNORM TAB1 ;
  427. @RMNORM TAB1 ;
  428. * ---- Flux normalise sur le maillage ombrant
  429. @RMFLUN TAB1 ;
  430.  
  431. MESS ' ';
  432. MESS 'WITHOUT TEST';
  433. MESS 'Distance covered :' DMAX1 ;
  434. MESS 'Step :' PASB1 ;
  435. MESS 'Iterations number :' NBPAS1 ;
  436. MESS ' ';
  437. MESS 'WITH TEST';
  438. MESS 'Distance covered :' DMAX2 ;
  439. MESS 'Step :' PASB2 ;
  440. MESS 'Iterations number :' NBPAS2 ;
  441. MESS ' ' ;
  442.  
  443. * --- initialisation du pas
  444. I1 = 0 ;
  445. * ---initialisation de la distance de connexion
  446. CHDIST = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
  447. * --- initialisation du flux normalise
  448. CHFNORM = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
  449. * --- initialisation du maillage ou on va tester les intersections
  450. s_ombre2 = s_ombre ;
  451. * --- initialisation du maillage ou on va remonter les lignes
  452. mailcou = s_ombre2 et mailpts ;
  453. * ---- initialisation des distances
  454. LCOURAN1 = 0. ;
  455. LMAX1 = 0. ;
  456. * ---- coordonnees
  457. XG_OLD = COOR 1 mailcou ;
  458. YG_OLD = COOR 2 mailcou ;
  459. ZG_OLD = COOR 3 mailcou ;
  460. *
  461. * --- initialisation des lignes de champ remontees
  462. REPETER BOUPTS1 NPTS ;
  463. tablig1 . &BOUPTS1 = TABPTS1 . &BOUPTS1 ;
  464. FIN BOUPTS1 ;
  465.  
  466. *--------------------------------------------------------------
  467. *
  468. * DEBUT DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  469. *
  470. *--------------------------------------------------------------
  471. *
  472. * ----- sans test d'interception
  473. PASB0 = PASB1 ;
  474. * increment de la distance de connexion (= PAS tant qu'il n'y a pas
  475. * d'intersection)
  476.  
  477. chdist9 = manu chpo s_ombre2 1 scal pasb0 ;
  478. chfn9 = manu chpo s_ombre2 1 scal 0. ;
  479. *
  480. * initialisation a 0 des deplacements
  481. DEPX0 = XG_OLD * 0. ;
  482. DEPY0 = YG_OLD * 0. ;
  483. DEPZ0 = ZG_OLD * 0. ;
  484. DEPX0 = NOMC UX DEPX0 NATURE DIFFUS ;
  485. DEPY0 = NOMC UY DEPY0 NATURE DIFFUS ;
  486. DEPZ0 = NOMC UZ DEPZ0 NATURE DIFFUS ;
  487. TAB1.<DEPLACEMENT = DEPX0 ET DEPY0 ET DEPZ0 ;
  488.  
  489. SI (NBPAS1 NEG 0) ;
  490. MESS 'WITHOUT INTERCEPTION TEST';
  491. REPETER BOUCLE1 NBPAS1 ;
  492. I1 = I1 + 1 ;
  493. LCOURAN1 = LCOURAN1 + PASB0 ;
  494. MESS ' ';
  495. MESS 'ITERATION : ' I1 'distance covered' LCOURAN1 ;
  496.  
  497. * ---- Appel de la procedure de descente des lignes de champ
  498. XG_NEW YG_NEW ZG_NEW DEP0 = @descend XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1;
  499. FORM DEP0 ;
  500. TAB1.<DEPLACEMENT = TAB1.<DEPLACEMENT + DEP0 ;
  501.  
  502. * --- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  503. chdist = chdist + CHDIST9 ;
  504.  
  505. * --- construction des lignes de champ remontees
  506. * --- Extraction des coordonnees des points a remonter
  507. * xmailpt2 = redu XG_NEW mailpts ;
  508. * ymailpt2 = redu YG_NEW mailpts ;
  509. * zmailpt2 = redu ZG_NEW mailpts ;
  510. *
  511. * --- Construction des lignes de remontee
  512. * repeter boupts2 npts ;
  513. * xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts2) ;
  514. * yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts2) ;
  515. * zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts2) ;
  516. * prem2 = xprem2 yprem2 zprem2 ;
  517. * tablig1.&boupts2 = (tablig1 . &boupts2) d 1 prem2 ;
  518. * fin boupts2 ;
  519.  
  520. * --- actualisation des champs de coordonnees pour iteration suivante
  521. XG_OLD = XG_NEW ;
  522. YG_OLD = YG_NEW ;
  523. ZG_OLD = ZG_NEW ;
  524. MENA ;
  525. FIN BOUCLE1 ;
  526. FINSI ;
  527.  
  528. MESS 'WITH INTERCEPTION TEST';
  529.  
  530. PASB0 = PASB2 ;
  531. s_ombreP = chan s_ombre poi1 ;
  532. s_ombre2 = chan s_ombre poi1 ;
  533. mailcou = s_ombre2 et mailpts ;
  534.  
  535. I2 = 0 ;
  536. I3 = 0 ;
  537. REPETER BOUCLE2 NBPAS2 ;
  538. I1 = I1 + 1 ;
  539. I3 = I3 + 1 ;
  540. SI (NBNO s_ombre2 > 0) ;
  541. * ---- si il reste des noeuds non encore intersectes
  542. LCOURAN1 = LCOURAN1 + PASB0 ;
  543. MESS ' ';
  544. MESS 'ITERATION : ' I1 'distance covered' LCOURAN1 ;
  545.  
  546. * ---- Appel de la procedure de descente des lignes de champ
  547. XG_NEW YG_NEW ZG_NEW DEP0 = @DESCEND XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1 ;
  548.  
  549. * ---- test sur les eventuels noeuds interceptes
  550. * ---- Les CHPO sont reduits sur les points de s_ombre
  551. * ---- qui n'ont pas encore ete intersectes : s_ombre2
  552. XG_OLD_R = REDU XG_OLD S_OMBRE2 ;
  553. YG_OLD_R = REDU YG_OLD S_OMBRE2 ;
  554. ZG_OLD_R = REDU ZG_OLD S_OMBRE2 ;
  555.  
  556. XG_NEW_R = REDU XG_NEW S_OMBRE2 ;
  557. YG_NEW_R = REDU YG_NEW S_OMBRE2 ;
  558. ZG_NEW_R = REDU ZG_NEW S_OMBRE2 ;
  559.  
  560. XG_OLD_R = NOMC X XG_OLD_R 'NATU' 'DIFFUS' ;
  561. YG_OLD_R = NOMC Y YG_OLD_R 'NATU' 'DIFFUS' ;
  562. ZG_OLD_R = NOMC Z ZG_OLD_R 'NATU' 'DIFFUS' ;
  563.  
  564. CH_OLD = XG_OLD_R ET YG_OLD_R ET ZG_OLD_R ;
  565.  
  566. XG_NEW_R = NOMC X XG_NEW_R 'NATU' 'DIFFUS' ;
  567. YG_NEW_R = NOMC Y YG_NEW_R 'NATU' 'DIFFUS' ;
  568. ZG_NEW_R = NOMC Z ZG_NEW_R 'NATU' 'DIFFUS' ;
  569.  
  570. CH_NEW = XG_NEW_R ET YG_NEW_R ET ZG_NEW_R ;
  571. *
  572. * ---- Test d'interception
  573. * CHDIST9 MINTER CHFN9 DEPMP1 = @INTSEC CH_OLD CH_NEW TOL1 TAB1 ;
  574. CHDIST9 MINTER CHFN9 DEPMP1 = IJET CH_OLD CH_NEW TOL1 TAB1 ;
  575.  
  576. * CHDIST9 = CHPO CONTENANT PAS POUR LES NOEUDS INTERSECTES
  577. * ET D(M,PT_REMONTE) SINON
  578.  
  579. * S_OMBRE2 contient les noeuds de s_ombre qui n'ont
  580. * pas ete intesectes
  581. * s_ombre0 contient les noeuds qui ont deja ete intersectes
  582. * minter contient les noeuds qui viennent d'etre intersectes
  583. s_ombre0 = diff s_ombreP s_ombre2 ;
  584. s_ombre2 = diff s_ombre2 MINTER ;
  585.  
  586. TITRE 'TEST : POINTS INTERCEPTES (BLANC ET JAUNE)' ;
  587. TRAC ((s_ombre2 coul roug) et MINTER et (s_ombre0 COUL JAUNE) et TAB1.<GRILLE_B et TAB1.<MAILLAGE_FN) ;
  588. *
  589. DEP01 = REDU DEP0 s_ombre2 ;
  590. DEP02 = MANU CHPO s_ombre0 3 UX 0. UY 0. UZ 0. NATURE DIFFUS ;
  591. SI ((NBNO MINTER) > 0) ;
  592. DEP0 = DEP01 ET DEP02 ET DEPMP1 ;
  593. SINON ;
  594. DEP0 = DEP01 ET DEP02 ;
  595. FINSI ;
  596.  
  597. FORM DEP0 ;
  598.  
  599. * ---- Test
  600. * i9 = 0 ;
  601. * repeter bouc01 (nbno (EXTR DEP0 'MAIL')) ;
  602. * i9 = i9 + 1 ;
  603. * list ((EXTR DEP0 'MAIL') poin i9) ;
  604. * list (redu CHFN9 ((EXTR DEP0 'MAIL') poin i9)) ;
  605. * fin bouc01 ;
  606. * TITRE 'TEST : NOEUDS SUPPORTS DU DEPLACEMENT';
  607. * TRAC (EXTR DEP0 'MAIL') ;
  608. * ---- Fin test
  609.  
  610. TAB1.<DEPLACEMENT = TAB1.<DEPLACEMENT + DEP0 ;
  611.  
  612. * ---- actualisation du maillage de descente
  613. mailcou = s_ombre2 et mailpts ;
  614.  
  615. CHSIGN1 = REDU CHSIGN1 mailcou ;
  616.  
  617. SI ((NBNO MINTER) > 0) ;
  618. mess (NBNO MINTER) 'intercepted points';
  619. LMAX1 = LCOURAN1 - pasb0 + (mini CHDIST9) ;
  620. FINSI ;
  621.  
  622. * ---- Distances parcourues avant interception
  623. chdist = chdist + CHDIST9 ;
  624. chfnorm = chfnorm + chfn9 ;
  625. mess 'mini maxi connection distance (m)' (mini (prog lmax1 (mini chdist))) lmax1 ;
  626. * list chfnorm ;
  627.  
  628. * --- construction des lignes de champ remontees
  629. * --- Extraction des coordonnees des points a remonter
  630. * xmailpt2 = redu XG_NEW mailpts ;
  631. * ymailpt2 = redu YG_NEW mailpts ;
  632. * zmailpt2 = redu ZG_NEW mailpts ;
  633. *
  634. * --- Construction des lignes de descentes
  635. * repeter boupts3 npts ;
  636. * xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts3) ;
  637. * yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts3) ;
  638. * zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts3) ;
  639. * prem2 = xprem2 yprem2 zprem2 ;
  640. * tablig1 . &boupts3 = (tablig1 . &boupts3) d 1 prem2 ;
  641. * fin boupts3 ;
  642.  
  643. * --- actualisation des champs de coordonnees pour iteration suivante
  644. XG_OLD = redu XG_NEW mailcou;
  645. YG_OLD = redu YG_NEW mailcou;
  646. ZG_OLD = redu ZG_NEW mailcou;
  647. MENA ;
  648. sinon ;
  649. SI (I2 EGA 0) ;
  650. MESS ' ';
  651. MESS 'ALL POINTS ARE INTERCEPTED' ;
  652. MESS ' ';
  653. I2 = I1 ;
  654. FINSI ;
  655. finsi ;
  656. FIN BOUCLE2 ;
  657.  
  658. *--- Sorties dans TAB1
  659. TAB1.<CHAMP_DISTANCE = CHDIST ;
  660. TAB1.<LONGUEUR_CONNEXION_MAX = LMAX1 ;
  661. TAB1.<LONGUEUR_PARCOURUE = LCOURAN1 ;
  662.  
  663. *si (exis tab1 <remontee) ;
  664. * tab1 . <remontee . <ligne = tablig1 ;
  665. *finsi ;
  666.  
  667. MESS '---------------------------------> exiting @ANADES';
  668. FINPROC chfnorm ;
  669.  
  670. **** @ANAJET
  671.  
  672. DEBPROC @ANAJET TAB1*TABLE ;
  673.  
  674. MESS '---------------------------------> calling @ANAJET';
  675. MESS 'METHODE ANALYTIQUE' ;
  676. *
  677. *--------------- VARIABLES D'ENTREE :
  678. *
  679.  
  680. S_OMBRE = TAB1.<S_OMBRE ;
  681. S_OMBRAN = TAB1.<S_OMBRANT ;
  682. IMETHOD = TAB1.<METHODE_REMONTEE ;
  683. CHSIGN1 = TAB1.<CHSIGN ;
  684.  
  685.  
  686. si (exis tab1 <remontee) ;
  687. TABPTS1 = TAB1.<REMONTEE.<POINT ;
  688. tablig1 = table ;
  689. finsi ;
  690.  
  691. PASB2 = TAB1.<PAS_AVEC_TEST ;
  692. DMAX2 = TAB1.<DIST_AVEC_TEST ;
  693. NBPAS2 = TAB1.<NBPAS2 ;
  694.  
  695. SI (EXIS TAB1 <PAS_SANS_TEST) ;
  696. PASB1 = TAB1.<PAS_SANS_TEST ;
  697. DMAX1 = TAB1.<DIST_SANS_TEST ;
  698. NBPAS1 = TAB1.<NBPAS1 ;
  699. FINSI ;
  700.  
  701.  
  702. SI (EXIS TAB1 <TOLERANCE) ;
  703. TOL1 = TAB1.<TOLERANCE ;
  704. SINON ;
  705. TOL1 = 1.e-9 ;
  706. FINSI ;
  707.  
  708. *
  709. * --- PASSAGE EN TRI3 POUR LA PROC @INTERC
  710. *
  711.  
  712. LMOT = s_ombran ELEM 'TYPE' ;
  713. ntyp = dime LMOT ;
  714. si (ntyp ega 2) ;
  715. stri3 = elem s_ombran tri3 ;
  716. squa4 = elem s_ombran qua4 ;
  717. squtri3 = chan squa4 tri3 ;
  718. s_ombra2 = squtri3 et stri3 ;
  719. sinon ;
  720. s_ombra2 = chan s_ombran tri3 ;
  721. finsi ;
  722.  
  723.  
  724. * --- CONSTRUCTION DU MAILLAGE DES POINTS A REMONTER
  725. si (exis tab1 <remontee) ;
  726. MAILPTS = MANU POI1 TABPTS1 . 1 ;
  727. NPTS = DIME TABPTS1 ;
  728. REPETER BOUPTS1 (NPTS - 1) ;
  729. MAILPTS = MAILPTS ET TABPTS1 . (&BOUPTS1 + 1) ;
  730. FIN BOUPTS1 ;
  731. sinon ;
  732. * RM 15/06/2000 MAILPTS = MANU POI1 (s_ombre poin init) ;
  733. MAILPTS = MANU POI1 ((chan s_ombre poi1) poin init) ;
  734. TABPTS1 = table ;
  735. TABPTS1 . 1 = (chan s_ombre poi1) poin init ;
  736. npts = 1 ;
  737. tablig1 = table ;
  738. finsi ;
  739.  
  740.  
  741. si (non (tab1.<reprise)) ;
  742. * --- CREATION DES 3 CHMELEM DE COORDONNEES AUX ELEMENTS
  743. * --- Remarque : ces coordonnees seront exprimees dans le repere globale
  744. TAB1.<MAILLAGE = S_OMBRA2 ;
  745. *AM*27/01/04 si (non (exis tab1 <chamx1)) ;
  746. *AM*27/01/04 @AMCOORO TAB1 ;
  747. @RMCOORO TAB1 ;
  748. *AM*27/01/04 finsi ;
  749. * --- CALCUL DES NORMALES AUX ELEMENTS SUR LE MAILLAGE OMBRANT
  750. *AM*27/01/04 si (non (exis tab1 <cosx)) ;
  751. @RMNORM TAB1 ;
  752. *AM*27/01/04 finsi ;
  753. finsi ;
  754.  
  755.  
  756. *
  757. * --- Rappel des parametres de la procedure
  758. *
  759. MESS ' ';
  760. MESS '##################################################';
  761. MESS ' ';
  762. MESS '>@ANAJET> procedure OMBJET, Rappel des parametres de calcul ';
  763. MESS ' ';
  764.  
  765. si (tab1.<reprise) ;
  766. mess 'Reprise d un calcul';
  767. mess '-------------------';
  768. finsi ;
  769.  
  770. SI (IMETHOD EGA 1) ;
  771. METH = 'methode explicite des tangentes';
  772. FINSI ;
  773. SI (IMETHOD EGA 2) ;
  774. METH = 'methode moyenne des tangentes aux extremitee';
  775. FINSI ;
  776. SI (IMETHOD EGA 3) ;
  777. METH = 'methode du point milieu';
  778. FINSI ;
  779. SI (IMETHOD EGA 4) ;
  780. METH = 'methode de reprojection';
  781. FINSI ;
  782. MESS ' ';
  783.  
  784. SI (EXIS tab1 <PAS_SANS_TEST) ;
  785. MESS 'Calcul en deux parties :';
  786. MESS ' ';
  787. MESS 'SANS TEST';
  788. MESS 'Distance remontee :' DMAX1 ;
  789. MESS 'Pas pour la remontee :' PASB1 ;
  790. MESS 'Nombre d iterations :' NBPAS1 ;
  791. MESS ' ';
  792. MESS 'AVEC TEST';
  793. MESS 'Distance remontee :' DMAX2 ;
  794. MESS 'Pas pour la remontee :' PASB2 ;
  795. MESS 'Nombre d iterations :' NBPAS2 ;
  796. SINON ;
  797. MESS 'Calcul avec test systematique :';
  798. MESS 'Distance remontee :' DMAX2 ;
  799. MESS 'Pas de remontee :' PASB2 ;
  800. MESS 'Nombre d iterations :' NBPAS2 ;
  801. FINSI ;
  802. MESS ' ' ;
  803.  
  804. *
  805. *--------------------------------------------------------------
  806. *
  807. * INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  808. * --- CAS SANS REPRISE ---
  809. *--------------------------------------------------------------
  810. si (non (tab1.<reprise)) ;
  811. * --- initialisation du pas
  812. I1 = 0 ;
  813. * ---initialisation de la distance de connexion
  814. CHDIST = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
  815. * --- initialisation du maillage ou on va tester les intersections
  816. s_ombre2 = s_ombre ;
  817. * --- initialisation du maillage ou on va remonter les lignes
  818. mailcou = s_ombre2 et mailpts ;
  819. *---- initialisation des distances
  820. LCOURAN1 = 0. ;
  821. LMAX1 = 0. ;
  822. * ---- coordonnees dans le repere du maillage
  823. XM0 = COOR 1 mailcou ;
  824. YM0 = COOR 2 mailcou ;
  825. ZM0 = COOR 3 mailcou ;
  826. *---- Coordonnees dans le repere global du tore
  827. XG_OLD = XM0 ;
  828. YG_OLD = YM0 ;
  829. ZG_OLD = ZM0 ;
  830.  
  831. *
  832. * --- initialisation des lignes de champ remontees
  833. REPETER BOUPTS1 NPTS ;
  834. tablig1 . &BOUPTS1 = TABPTS1 . &BOUPTS1 ;
  835. FIN BOUPTS1 ;
  836.  
  837. sinon ;
  838. *
  839. *--------------------------------------------------------------
  840. *
  841. * INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  842. * --- CAS AVEC REPRISE ---
  843. *--------------------------------------------------------------
  844. * --- initialisation du pas
  845. I1 = tab1.<i_ombrage ;
  846. * --- initialisation de la distance de connexion
  847. CHDIST = tab1.<chdist;
  848. * --- initialisation du maillage ou on va tester les intersections
  849. s_ombre2 = tab1.<s_omb_non_inter ;
  850. * --- initialisation du maillage ou on va remonter les lignes
  851. mailcou = s_ombre2 et mailpts ;
  852.  
  853.  
  854. *---- initialisation des distances
  855. LCOURAN1 = maxi chdist ;
  856. LMAX1 = tab1.<CONNEXION_MAX ;
  857.  
  858. *---- Coordonnees dans le repere global du tore
  859. XG_OLD = exco X tab1.<CHCOOR0 ;
  860. YG_OLD = exco Y tab1.<CHCOOR0 ;
  861. ZG_OLD = exco Z tab1.<CHCOOR0 ;
  862. *
  863.  
  864. * --- initialisation des lignes de champ remontees
  865. si (exis tab1 <remontee) ;
  866. tablig1 = tab1.<remontee.<ligne ;
  867. sinon ;
  868. tablig1 . 1 = (TABPTS1 . 1) d 1 (TABPTS1.1 plus (0. 0. 0.));
  869. finsi ;
  870.  
  871. finsi ;
  872.  
  873. *--------------------------------------------------------------
  874. *
  875. * DEBUT DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  876. *
  877. *--------------------------------------------------------------
  878. *
  879. MESS ' ';
  880. MESS '##################################################';
  881. MESS ' ';
  882.  
  883. SI (EXIS TAB1 <DIST_SANS_TEST) ;
  884.  
  885. * ------------------ Boucle 1 on remonte sans test -------------------
  886. PASB0 = PASB1 ;
  887. * increment de la distance de connexion (= PAS tant qu'il n'y a pas
  888. * d'intersection)
  889. chdist9 = manu chpo s_ombre2 1 scal pasb0 ;
  890.  
  891. *
  892. * initialisation a 0 des deplacements
  893. DEPX0 = XG_OLD * 0. ;
  894. DEPY0 = YG_OLD * 0. ;
  895. DEPZ0 = ZG_OLD * 0. ;
  896. DEPX0 = NOMC UX DEPX0 NATURE DIFFUS ;
  897. DEPY0 = NOMC UY DEPY0 NATURE DIFFUS ;
  898. DEPZ0 = NOMC UZ DEPZ0 NATURE DIFFUS ;
  899. TAB1.<DEPLACE = DEPX0 ET DEPY0 ET DEPZ0 ;
  900.  
  901. MESS 'PREMIERE PARTIE DU CALCUL, SANS TEST D INTERSECTION';
  902. REPETER BOUCLE1 NBPAS1 ;
  903. I1 = I1 + 1 ;
  904. LCOURAN1 = LCOURAN1 + PASB0 ;
  905. MESS ' ';
  906. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  907.  
  908. * ---- Appel de la procedure de remontee des lignes de champ
  909. XG_NEW YG_NEW ZG_NEW DEP0 = @remojet XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1 ;
  910. FORM DEP0 ;
  911. TAB1.<DEPLACE = TAB1.<DEPLACE + DEP0 ;
  912. TITRE 'SANS TEST, ITERATION : 'I1 ;
  913. TRAC ((s_ombre2 coul roug) ET TAB1.<GRILLE_B ET TAB1.<S_OMBRANT) ;
  914.  
  915. *--- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  916. chdist = chdist + CHDIST9 ;
  917.  
  918.  
  919. *-----------------------------------------------------------------
  920. *--- construction des lignes de champ remontees
  921. * --- Extraction des coordonnees des points a remonter
  922. xmailpt1 = redu XG_NEW mailpts ;
  923. ymailpt1 = redu YG_NEW mailpts ;
  924. zmailpt1 = redu ZG_NEW mailpts ;
  925.  
  926. * --- Calcul des coordonnees des points a remonter dans le repere du maillage
  927. xmailpt2 = xmailpt1 ;
  928. ymailpt2 = ymailpt1 ;
  929. zmailpt2 = zmailpt1 ;
  930.  
  931. *
  932. * --- Construction des lignes de remontee
  933. repeter boupts2 npts ;
  934. xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts2) ;
  935. yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts2) ;
  936. zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts2) ;
  937. prem2 = xprem2 yprem2 zprem2 ;
  938. tablig1.&boupts2 = (tablig1 . &boupts2) d 1 prem2 ;
  939. fin boupts2 ;
  940. **-----------------------------------------------------------------
  941.  
  942.  
  943. * --- actualisation des champs de coordonnees pour iteration suivante
  944.  
  945. XG_OLD = XG_NEW ;
  946. YG_OLD = YG_NEW ;
  947. ZG_OLD = ZG_NEW ;
  948.  
  949. MENA ;
  950.  
  951. FIN BOUCLE1 ;
  952. * ------------------------ Fin de la boucle 1 ------------------------
  953. finsi ;
  954.  
  955.  
  956. MESS ' ';
  957. MESS '##################################################';
  958. MESS ' ';
  959.  
  960. MESS 'CALCUL AVEC TEST D INTERSECTION';
  961.  
  962. * ------------------ Boucle 2 on remonte avec test -------------------
  963. PASB0 = PASB2 ;
  964. si (non (tab1.<reprise)) ;
  965. s_ombre2 = chan s_ombre poi1 ;
  966. mailcou = s_ombre2 et mailpts ;
  967. finsi ;
  968. REPETER BOUCLE2 NBPAS2 ;
  969.  
  970. I1 = I1 + 1 ;
  971. LCOURAN1 = LCOURAN1 + PASB0 ;
  972. MESS ' ';
  973. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  974.  
  975. * ---- Appel de la procedure de remonter des lignes de champ
  976. XG_NEW YG_NEW ZG_NEW DEP0 = @remojet XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1 ;
  977. *---- ------test sur les eventuels noeuds interceptes -----------
  978. *---- seulement s'il reste des noeuds non encore intersectes ----
  979. si (nbno s_ombre2 > 0.) ;
  980.  
  981. * --- Les CHPO sont reduits sur les points de s_ombre
  982. * --- qui n'ont pas encore ete intersectes : s_ombre2
  983.  
  984. XG_OLD_R = REDU XG_OLD S_OMBRE2 ;
  985. YG_OLD_R = REDU YG_OLD S_OMBRE2 ;
  986. ZG_OLD_R = REDU ZG_OLD S_OMBRE2 ;
  987.  
  988. XG_NEW_R = REDU XG_NEW S_OMBRE2 ;
  989. YG_NEW_R = REDU YG_NEW S_OMBRE2 ;
  990. ZG_NEW_R = REDU ZG_NEW S_OMBRE2 ;
  991.  
  992.  
  993. XG_OLD_R = NOMC X XG_OLD_R 'NATU' 'DIFFUS' ;
  994. YG_OLD_R = NOMC Y YG_OLD_R 'NATU' 'DIFFUS' ;
  995. ZG_OLD_R = NOMC Z ZG_OLD_R 'NATU' 'DIFFUS' ;
  996.  
  997. CH_OLD = XG_OLD_R ET YG_OLD_R ET ZG_OLD_R ;
  998.  
  999.  
  1000. XG_NEW_R = NOMC X XG_NEW_R 'NATU' 'DIFFUS' ;
  1001. YG_NEW_R = NOMC Y YG_NEW_R 'NATU' 'DIFFUS' ;
  1002. ZG_NEW_R = NOMC Z ZG_NEW_R 'NATU' 'DIFFUS' ;
  1003.  
  1004. CH_NEW = XG_NEW_R ET YG_NEW_R ET ZG_NEW_R ;
  1005.  
  1006. *
  1007. * --- APPEL DE LA PROCEDURE DE CALCUL DES NOEUDS INTERSECTES
  1008. *
  1009. * CHDIST9 MINTER = @INTERC CH_OLD CH_NEW TOL1 TAB1 ;
  1010. CHDIST9 MINTER = ITRC CH_OLD CH_NEW TOL1 TAB1 ;
  1011.  
  1012. * CHDIST9 = CHPO CONTENANT PAS POUR LES NOEUDS INTERSECTES
  1013. * ET D(M,PT_REMONTE) SINON
  1014.  
  1015.  
  1016. * S_OMBRE2 contient les noeuds de s_ombre qui n'ont
  1017. * pas ete intesectes.
  1018. s_ombre2 = diff s_ombre2 MINTER ;
  1019.  
  1020. * actualisation du maillage de remontee
  1021. mailcou = s_ombre2 et mailpts ;
  1022.  
  1023. CHSIGN1 = REDU CHSIGN1 mailcou ;
  1024.  
  1025. SI ((NBNO MINTER) > 0) ;
  1026. mess 'nombre de noeuds intersectes ' (NBNO MINTER) ;
  1027. LMAX1 = LCOURAN1 - pasb0 + (mini CHDIST9) ;
  1028. FINSI ;
  1029.  
  1030. * --- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  1031. chdist = chdist + CHDIST9 ;
  1032. mess 'mini maxi dist connection en m' (mini (prog lmax1 (mini chdist))) lmax1 ;
  1033.  
  1034.  
  1035. finsi ;
  1036. * ------------------ fin du test d'interception ------------------
  1037.  
  1038.  
  1039.  
  1040. *-----------------------------------------------------------------
  1041. *--- construction des lignes de champ remontees
  1042. *--- Extraction des coordonnees des points a remonter
  1043. xmailpt1 = redu XG_NEW mailpts ;
  1044. ymailpt1 = redu YG_NEW mailpts ;
  1045. zmailpt1 = redu ZG_NEW mailpts ;
  1046.  
  1047. *--- Calcul des coordonnees des points a remonter dans le repere du maillage
  1048. xmailpt2 = xmailpt1 ;
  1049. ymailpt2 = ymailpt1 ;
  1050. zmailpt2 = zmailpt1 ;
  1051.  
  1052. *--- Construction des lignes de remontee
  1053. repeter boupts3 npts ;
  1054. xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts3) ;
  1055. yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts3) ;
  1056. zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts3) ;
  1057. prem2 = xprem2 yprem2 zprem2 ;
  1058. tablig1 . &boupts3 = (tablig1 . &boupts3) d 1 prem2 ;
  1059. fin boupts3 ;
  1060. *-----------------------------------------------------------------
  1061.  
  1062.  
  1063.  
  1064. * --- actualisation des champs de coordonnees pour iteration suivante
  1065.  
  1066. XG_OLD = redu XG_NEW mailcou;
  1067. YG_OLD = redu YG_NEW mailcou;
  1068. ZG_OLD = redu ZG_NEW mailcou;
  1069.  
  1070. MENA ;
  1071. FORM DEP0 ;
  1072. TAB1.<DEPLACE = TAB1.<DEPLACE + DEP0 ;
  1073. TITRE 'AVEC TEST, ITERATION : 'I1 ;
  1074. TRAC ((s_ombre2 coul roug) ET MINTER ET TAB1.<GRILLE_B ET TAB1.<S_OMBRANT) ;
  1075.  
  1076. FIN BOUCLE2 ;
  1077. * --------------------- Fin de la boucle 2 ----------------------
  1078.  
  1079.  
  1080. *--- Sorties dans TAB1
  1081.  
  1082. TAB1.<CHDIST = CHDIST ;
  1083. TAB1.<CONNEXION_MAX = LMAX1 ;
  1084. TAB1.<LONGUEUR_REMONTEE = LCOURAN1 ;
  1085.  
  1086. si (exis tab1 <remontee) ;
  1087. tab1 . <remontee . <ligne = tablig1 ;
  1088. finsi ;
  1089.  
  1090. *Sauvegardes pour reprise eventuelle
  1091. XG_OLD = nomc X XG_OLD nature discret ;
  1092. YG_OLD = nomc Y YG_OLD nature discret ;
  1093. ZG_OLD = nomc Z ZG_OLD nature discret ;
  1094. tab1.<CHCOOR0 = (XG_OLD et YG_OLD et ZG_OLD) ;
  1095. tab1.<s_omb_non_inter = s_ombre2 ;
  1096. tab1.<i_ombrage = i1 ;
  1097.  
  1098. MESS '---------------------------------> exiting @ANAJET';
  1099. FINPROC ;
  1100.  
  1101. **** @ANALY
  1102.  
  1103. DEBPROC @ANALY TAB1*TABLE ;
  1104.  
  1105. MESS '---------------------------------> calling @ANALY';
  1106. MESS 'METHODE ANALYTIQUE' ;
  1107. *
  1108. *--------------- VARIABLES D'ENTREE :
  1109. *
  1110.  
  1111. S_OMBRE = TAB1.<S_OMBRE ;
  1112. S_OMBRAN = TAB1.<S_OMBRANT ;
  1113. IMETHOD = TAB1.<METHODE_REMONTEE ;
  1114. CHSIGN1 = TAB1.<CHSIGN ;
  1115.  
  1116. TYPCAL = TAB1.<TYPE_CALCUL ;
  1117. RP = TAB1.<RP ;
  1118. RHO0 = TAB1.<RHO0 ;
  1119. RR = TAB1.<RR ;
  1120. HP = TAB1.<HP ;
  1121. EPS0 = TAB1.<EPS ;
  1122. COEFA = TAB1.<COEFA ;
  1123. COEFB = TAB1.<COEFB ;
  1124. COEFC = TAB1.<COEFC ;
  1125. NBOB = TAB1.<NBOB ;
  1126.  
  1127. si (exis tab1 <remontee) ;
  1128. TABPTS1 = TAB1.<REMONTEE.<POINT ;
  1129. tablig1 = table ;
  1130. finsi ;
  1131.  
  1132. PASB2 = TAB1.<PAS_AVEC_TEST ;
  1133. DMAX2 = TAB1.<DIST_AVEC_TEST ;
  1134. NBPAS2 = TAB1.<NBPAS2 ;
  1135.  
  1136. SI (EXIS TAB1 <PAS_SANS_TEST) ;
  1137. PASB1 = TAB1.<PAS_SANS_TEST ;
  1138. DMAX1 = TAB1.<DIST_SANS_TEST ;
  1139. NBPAS1 = TAB1.<NBPAS1 ;
  1140. FINSI ;
  1141.  
  1142.  
  1143. SI (EXIS TAB1 <TOLERANCE) ;
  1144. TOL1 = TAB1.<TOLERANCE ;
  1145. SINON ;
  1146. TOL1 = 1.e-9 ;
  1147. FINSI ;
  1148.  
  1149. *
  1150. * --- PASSAGE EN TRI3 POUR LA PROC @INTERC
  1151. *
  1152.  
  1153. LMOT = s_ombran ELEM 'TYPE' ;
  1154. ntyp = dime LMOT ;
  1155. si (ntyp ega 2) ;
  1156. stri3 = elem s_ombran tri3 ;
  1157. squa4 = elem s_ombran qua4 ;
  1158. squtri3 = chan squa4 tri3 ;
  1159. s_ombra2 = squtri3 et stri3 ;
  1160. sinon ;
  1161. s_ombra2 = chan s_ombran tri3 ;
  1162. finsi ;
  1163.  
  1164. *
  1165. * ---
  1166. *
  1167. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  1168. ISHIFT = VRAI ;
  1169. IRIPPLE = VRAI ;
  1170. FINSI ;
  1171. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  1172. ISHIFT = VRAI ;
  1173. IRIPPLE = FAUX ;
  1174. FINSI ;
  1175. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  1176. ISHIFT = FAUX ;
  1177. IRIPPLE = VRAI ;
  1178. FINSI ;
  1179. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  1180. ISHIFT = FAUX ;
  1181. IRIPPLE = FAUX ;
  1182. FINSI ;
  1183. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  1184. ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
  1185. FINSI ;
  1186.  
  1187.  
  1188. * --- CONSTRUCTION DU MAILLAGE DES POINTS A REMONTER
  1189. si (exis tab1 <remontee) ;
  1190. MAILPTS = MANU POI1 TABPTS1 . 1 ;
  1191. NPTS = DIME TABPTS1 ;
  1192. REPETER BOUPTS1 (NPTS - 1) ;
  1193. MAILPTS = MAILPTS ET TABPTS1 . (&BOUPTS1 + 1) ;
  1194. FIN BOUPTS1 ;
  1195. sinon ;
  1196. * RM 15/06/2000 MAILPTS = MANU POI1 (s_ombre poin init) ;
  1197. MAILPTS = MANU POI1 ((chan s_ombre poi1) poin init) ;
  1198. TABPTS1 = table ;
  1199. TABPTS1 . 1 = (chan s_ombre poi1) poin init ;
  1200. npts = 1 ;
  1201. tablig1 = table ;
  1202. finsi ;
  1203.  
  1204.  
  1205. si (non (tab1.<reprise)) ;
  1206. * --- CREATION DES 3 CHMELEM DE COORDONNEES AUX ELEMENTS
  1207. * --- Remarque : ces coordonnees seront exprimees dans le repere globale
  1208. TAB1.<MAILLAGE = S_OMBRA2 ;
  1209. si (non (exis tab1 <chamx1)) ;
  1210. @RMCOORO TAB1 ;
  1211. finsi ;
  1212. * --- CALCUL DES NORMALES AUX ELEMENTS SUR LE MAILLAGE OMBRANT
  1213. si (non (exis tab1 <cosx)) ;
  1214. @RMNORM TAB1 ;
  1215. finsi ;
  1216. finsi ;
  1217.  
  1218.  
  1219. *
  1220. * --- Rappel des parametres de la procedure
  1221. *
  1222. MESS ' ';
  1223. MESS '##################################################';
  1224. MESS ' ';
  1225. MESS '>@ANALY> procedure OMBRAGE, Rappel des parametres de calcul ';
  1226. MESS ' ';
  1227.  
  1228. si (tab1.<reprise) ;
  1229. mess 'Reprise d un calcul';
  1230. mess '-------------------';
  1231. finsi ;
  1232.  
  1233. SI (IMETHOD EGA 1) ;
  1234. METH = 'methode explicite des tangentes';
  1235. FINSI ;
  1236. SI (IMETHOD EGA 2) ;
  1237. METH = 'methode moyenne des tangentes aux extremitee';
  1238. FINSI ;
  1239. SI (IMETHOD EGA 3) ;
  1240. METH = 'methode du point milieu';
  1241. FINSI ;
  1242. SI (IMETHOD EGA 4) ;
  1243. METH = 'methode de reprojection';
  1244. FINSI ;
  1245. MESS ' ';
  1246.  
  1247. SI (EXIS tab1 <PAS_SANS_TEST) ;
  1248. MESS 'Calcul en deux parties :';
  1249. MESS ' ';
  1250. MESS 'SANS TEST';
  1251. MESS 'Distance remontee :' DMAX1 ;
  1252. MESS 'Pas pour la remontee :' PASB1 ;
  1253. MESS 'Nombre d iterations :' NBPAS1 ;
  1254. MESS ' ';
  1255. MESS 'AVEC TEST';
  1256. MESS 'Distance remontee :' DMAX2 ;
  1257. MESS 'Pas pour la remontee :' PASB2 ;
  1258. MESS 'Nombre d iterations :' NBPAS2 ;
  1259. SINON ;
  1260. MESS 'Calcul avec test systematique :';
  1261. MESS 'Distance remontee :' DMAX2 ;
  1262. MESS 'Pas de remontee :' PASB2 ;
  1263. MESS 'Nombre d iterations :' NBPAS2 ;
  1264. FINSI ;
  1265. MESS ' ' ;
  1266.  
  1267. SI ISHIFT ;
  1268. MESS 'Calcul avec shift de Safranov' ;
  1269. SINON ;
  1270. MESS 'Calcul sans shift de Safranov';
  1271. FINSI ;
  1272.  
  1273. SI IRIPPLE ;
  1274. MESS 'Calcul avec ripple du champ toroidal' ;
  1275. SINON ;
  1276. MESS 'Calcul sans ripple du champ toroidal' ;
  1277. FINSI ;
  1278.  
  1279.  
  1280. *
  1281. *--------------------------------------------------------------
  1282. *
  1283. * INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  1284. * --- CAS SANS REPRISE ---
  1285. *--------------------------------------------------------------
  1286. si (non (tab1.<reprise)) ;
  1287. * --- initialisation du pas
  1288. I1 = 0 ;
  1289. * ---initialisation de la distance de connexion
  1290. CHDIST = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
  1291. * --- initialisation du maillage ou on va tester les intersections
  1292. s_ombre2 = s_ombre ;
  1293. * --- initialisation du maillage ou on va remonter les lignes
  1294. mailcou = s_ombre2 et mailpts ;
  1295. *---- initialisation des distances
  1296. LCOURAN1 = 0. ;
  1297. LMAX1 = 0. ;
  1298. * ---- coordonnees dans le repere du maillage
  1299. XM0 = COOR 1 mailcou ;
  1300. YM0 = COOR 2 mailcou ;
  1301. ZM0 = COOR 3 mailcou ;
  1302. *---- Coordonnees dans le repere global du tore
  1303. XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
  1304. *
  1305. * --- initialisation des lignes de champ remontees
  1306. REPETER BOUPTS1 NPTS ;
  1307. tablig1 . &BOUPTS1 = TABPTS1 . &BOUPTS1 ;
  1308. FIN BOUPTS1 ;
  1309.  
  1310. sinon ;
  1311. *
  1312. *--------------------------------------------------------------
  1313. *
  1314. * INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  1315. * --- CAS AVEC REPRISE ---
  1316. *--------------------------------------------------------------
  1317. * --- initialisation du pas
  1318. I1 = tab1.<i_ombrage ;
  1319. * --- initialisation de la distance de connexion
  1320. CHDIST = tab1.<chdist;
  1321. * --- initialisation du maillage ou on va tester les intersections
  1322. s_ombre2 = tab1.<s_omb_non_inter ;
  1323. * --- initialisation du maillage ou on va remonter les lignes
  1324. mailcou = s_ombre2 et mailpts ;
  1325.  
  1326.  
  1327. *---- initialisation des distances
  1328. LCOURAN1 = maxi chdist ;
  1329. LMAX1 = tab1.<CONNEXION_MAX ;
  1330.  
  1331. *---- Coordonnees dans le repere global du tore
  1332. XG_OLD = exco X tab1.<CHCOOR0 ;
  1333. YG_OLD = exco Y tab1.<CHCOOR0 ;
  1334. ZG_OLD = exco Z tab1.<CHCOOR0 ;
  1335. *
  1336.  
  1337. * --- initialisation des lignes de champ remontees
  1338. si (exis tab1 <remontee) ;
  1339. tablig1 = tab1.<remontee.<ligne ;
  1340. sinon ;
  1341. tablig1 . 1 = (TABPTS1 . 1) d 1 (TABPTS1.1 plus (0. 0. 0.));
  1342. finsi ;
  1343.  
  1344. finsi ;
  1345.  
  1346. *--------------------------------------------------------------
  1347. *
  1348. * DEBUT DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  1349. *
  1350. *--------------------------------------------------------------
  1351. *
  1352. MESS ' ';
  1353. MESS '##################################################';
  1354. MESS ' ';
  1355.  
  1356. SI (EXIS TAB1 <DIST_SANS_TEST) ;
  1357.  
  1358. * ------------------ Boucle 1 on remonte sans test -------------------
  1359. PASB0 = PASB1 ;
  1360. * increment de la distance de connexion (= PAS tant qu'il n'y a pas
  1361. * d'intersection)
  1362. chdist9 = manu chpo s_ombre2 1 scal pasb0 ;
  1363.  
  1364. MESS 'PREMIERE PARTIE DU CALCUL, SANS TEST D INTERSECTION';
  1365. REPETER BOUCLE1 NBPAS1 ;
  1366. I1 = I1 + 1 ;
  1367. LCOURAN1 = LCOURAN1 + PASB0 ;
  1368. MESS ' ';
  1369. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  1370.  
  1371. * ---- Appel de la procedure de remontee des lignes de champ
  1372. XG_NEW YG_NEW ZG_NEW = @remonte XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1 ;
  1373.  
  1374. *--- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  1375. chdist = chdist + CHDIST9 ;
  1376.  
  1377.  
  1378. *-----------------------------------------------------------------
  1379. *--- construction des lignes de champ remontees
  1380. * --- Extraction des coordonnees des points a remonter
  1381. xmailpt1 = redu XG_NEW mailpts ;
  1382. ymailpt1 = redu YG_NEW mailpts ;
  1383. zmailpt1 = redu ZG_NEW mailpts ;
  1384.  
  1385. * --- Calcul des coordonnees des points a remonter dans le repere du maillage
  1386. xmailpt2 ymailpt2 zmailpt2 = @crgmc xmailpt1 ymailpt1 zmailpt1 tab1 ;
  1387. *
  1388. * --- Construction des lignes de remontee
  1389. repeter boupts2 npts ;
  1390. xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts2) ;
  1391. yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts2) ;
  1392. zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts2) ;
  1393. prem2 = xprem2 yprem2 zprem2 ;
  1394. tablig1.&boupts2 = (tablig1 . &boupts2) d 1 prem2 ;
  1395. fin boupts2 ;
  1396. **-----------------------------------------------------------------
  1397.  
  1398.  
  1399. * --- actualisation des champs de coordonnees pour iteration suivante
  1400.  
  1401. XG_OLD = XG_NEW ;
  1402. YG_OLD = YG_NEW ;
  1403. ZG_OLD = ZG_NEW ;
  1404.  
  1405. MENA ;
  1406.  
  1407. FIN BOUCLE1 ;
  1408. * ------------------------ Fin de la boucle 1 ------------------------
  1409. finsi ;
  1410.  
  1411.  
  1412. MESS ' ';
  1413. MESS '##################################################';
  1414. MESS ' ';
  1415.  
  1416. MESS 'CALCUL AVEC TEST D INTERSECTION';
  1417.  
  1418. * ------------------ Boucle 2 on remonte avec test -------------------
  1419. PASB0 = PASB2 ;
  1420. si (non (tab1.<reprise)) ;
  1421. s_ombre2 = chan s_ombre poi1 ;
  1422. mailcou = s_ombre2 et mailpts ;
  1423. finsi ;
  1424. REPETER BOUCLE2 NBPAS2 ;
  1425.  
  1426. I1 = I1 + 1 ;
  1427. LCOURAN1 = LCOURAN1 + PASB0 ;
  1428. MESS ' ';
  1429. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  1430.  
  1431. * ---- Appel de la procedure de remonter des lignes de champ
  1432. XG_NEW YG_NEW ZG_NEW = @remonte XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1 ;
  1433. *---- ------test sur les eventuels noeuds interceptes -----------
  1434. *---- seulement s'il reste des noeuds non encore intersectes ----
  1435. si (nbno s_ombre2 > 0.) ;
  1436.  
  1437. * --- Les CHPO sont reduits sur les points de s_ombre
  1438. * --- qui n'ont pas encore ete intersectes : s_ombre2
  1439.  
  1440. XG_OLD_R = REDU XG_OLD S_OMBRE2 ;
  1441. YG_OLD_R = REDU YG_OLD S_OMBRE2 ;
  1442. ZG_OLD_R = REDU ZG_OLD S_OMBRE2 ;
  1443.  
  1444. XG_NEW_R = REDU XG_NEW S_OMBRE2 ;
  1445. YG_NEW_R = REDU YG_NEW S_OMBRE2 ;
  1446. ZG_NEW_R = REDU ZG_NEW S_OMBRE2 ;
  1447.  
  1448.  
  1449. XG_OLD_R = NOMC X XG_OLD_R 'NATU' 'DIFFUS' ;
  1450. YG_OLD_R = NOMC Y YG_OLD_R 'NATU' 'DIFFUS' ;
  1451. ZG_OLD_R = NOMC Z ZG_OLD_R 'NATU' 'DIFFUS' ;
  1452.  
  1453. CH_OLD = XG_OLD_R ET YG_OLD_R ET ZG_OLD_R ;
  1454.  
  1455.  
  1456. XG_NEW_R = NOMC X XG_NEW_R 'NATU' 'DIFFUS' ;
  1457. YG_NEW_R = NOMC Y YG_NEW_R 'NATU' 'DIFFUS' ;
  1458. ZG_NEW_R = NOMC Z ZG_NEW_R 'NATU' 'DIFFUS' ;
  1459.  
  1460. CH_NEW = XG_NEW_R ET YG_NEW_R ET ZG_NEW_R ;
  1461.  
  1462. *
  1463. * --- APPEL DE LA PROCEDURE DE CALCUL DES NOEUDS INTERSECTES
  1464. *
  1465. * CHDIST9 MINTER = @INTERC CH_OLD CH_NEW TOL1 TAB1 ;
  1466. CHDIST9 MINTER = ITRC CH_OLD CH_NEW TOL1 TAB1 ;
  1467.  
  1468. * CHDIST9 = CHPO CONTENANT PAS POUR LES NOEUDS INTERSECTES
  1469. * ET D(M,PT_REMONTE) SINON
  1470.  
  1471.  
  1472. * S_OMBRE2 contient les noeuds de s_ombre qui n'ont
  1473. * pas ete intesectes.
  1474. s_ombre2 = diff s_ombre2 MINTER ;
  1475.  
  1476. * actualisation du maillage de remontee
  1477. mailcou = s_ombre2 et mailpts ;
  1478.  
  1479. CHSIGN1 = REDU CHSIGN1 mailcou ;
  1480.  
  1481. SI ((NBNO MINTER) > 0) ;
  1482. mess 'nombre de noeuds intersectes ' (NBNO MINTER) ;
  1483. LMAX1 = LCOURAN1 - pasb0 + (mini CHDIST9) ;
  1484. FINSI ;
  1485.  
  1486. * --- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  1487. chdist = chdist + CHDIST9 ;
  1488. mess 'mini maxi dist connection en m' (mini (prog lmax1 (mini chdist))) lmax1 ;
  1489.  
  1490.  
  1491. finsi ;
  1492. * ------------------ fin du test d'interception ------------------
  1493.  
  1494.  
  1495.  
  1496. *-----------------------------------------------------------------
  1497. *--- construction des lignes de champ remontees
  1498. *--- Extraction des coordonnees des points a remonter
  1499. xmailpt1 = redu XG_NEW mailpts ;
  1500. ymailpt1 = redu YG_NEW mailpts ;
  1501. zmailpt1 = redu ZG_NEW mailpts ;
  1502.  
  1503. *--- Calcul des coordonnees des points a remonter dans le repere du maillage
  1504. xmailpt2 ymailpt2 zmailpt2 = @crgmc xmailpt1 ymailpt1 zmailpt1 tab1 ;
  1505.  
  1506. *--- Construction des lignes de remontee
  1507. repeter boupts3 npts ;
  1508. xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts3) ;
  1509. yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts3) ;
  1510. zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts3) ;
  1511. prem2 = xprem2 yprem2 zprem2 ;
  1512. tablig1 . &boupts3 = (tablig1 . &boupts3) d 1 prem2 ;
  1513. fin boupts3 ;
  1514. *-----------------------------------------------------------------
  1515.  
  1516.  
  1517.  
  1518. * --- actualisation des champs de coordonnees pour iteration suivante
  1519.  
  1520. XG_OLD = redu XG_NEW mailcou;
  1521. YG_OLD = redu YG_NEW mailcou;
  1522. ZG_OLD = redu ZG_NEW mailcou;
  1523.  
  1524. MENA ;
  1525.  
  1526. FIN BOUCLE2 ;
  1527. * --------------------- Fin de la boucle 2 ----------------------
  1528.  
  1529.  
  1530. *--- Sorties dans TAB1
  1531.  
  1532. TAB1.<CHDIST = CHDIST ;
  1533. TAB1.<CONNEXION_MAX = LMAX1 ;
  1534. TAB1.<LONGUEUR_REMONTEE = LCOURAN1 ;
  1535.  
  1536. si (exis tab1 <remontee) ;
  1537. tab1 . <remontee . <ligne = tablig1 ;
  1538. finsi ;
  1539.  
  1540. *Sauvegardes pour reprise eventuelle
  1541. XG_OLD = nomc X XG_OLD nature discret ;
  1542. YG_OLD = nomc Y YG_OLD nature discret ;
  1543. ZG_OLD = nomc Z ZG_OLD nature discret ;
  1544. tab1.<CHCOOR0 = (XG_OLD et YG_OLD et ZG_OLD) ;
  1545. tab1.<s_omb_non_inter = s_ombre2 ;
  1546. tab1.<i_ombrage = i1 ;
  1547.  
  1548. MESS '---------------------------------> exiting @ANALY';
  1549. FINPROC ;
  1550.  
  1551. **** @ARANGU
  1552. DEBPROC @ARANGU T1*FLOTTANT V1*FLOTTANT E1*FLOTTANT ;
  1553. *-------------------------------------------------------------------*
  1554. * R. Mitteau
  1555. * Fatigue du cuivre OFHC
  1556. *
  1557. * D'apres la publi
  1558. *
  1559. *
  1560. * High Temperature Torsional Low Cycle Fatigue of OFHC Copper
  1561. * Ahmet Aran and Dogan Erdun Gucer, Material Research Division,
  1562. * Marmara Research Institute...
  1563. *
  1564. * in Z. Metallkunde
  1565. * T1 temperature en degres K
  1566. * V1 vitesse de deformation en s-1
  1567. * E1 Deformation en .
  1568. *
  1569. *
  1570. *23456789012345678901234567890123456789012345678901234567890123456789012
  1571. * 1 2 3 4 5 6 7
  1572. *-------------------------------------------------------------------*
  1573. MESS '-----------------------------------------------> calling @ARANGU';
  1574. *
  1575. * --- donnees
  1576. *
  1577. * Temperature de la matiere en Kelvin
  1578. TLIEU1 = T1 ;
  1579. * Variation equivalente de la deformation au lieu considere
  1580. EPSETOI1 = E1 ;
  1581. * Vitesse de deformation
  1582. VDEF1 = V1 ;
  1583.  
  1584. *
  1585. * --- Calcul du alpha de la loi de Mansson-Coffin
  1586. *
  1587. EVALPH1 = EVOL MANU 'T' (PROG 293 438 588 668 ) 'ALPH' (PROG .67 .71 .63 .50 );
  1588. EVALPH2 = EVOL MANU 'T' (PROG 293 438 588 668 ) 'ALPH' (PROG .64 .79 .69 .50 );
  1589.  
  1590. VALALPH1 = IPOE EVALPH1 TLIEU1 FIXE;
  1591. VALALPH2 = IPOE EVALPH2 TLIEU1 FIXE;
  1592.  
  1593. EVALPH3 = EVOL MANU 'VDEF' (PROG 1.81E-3 9.05E-3 ) 'ALPH' (PROG VALALPH1 VALALPH2);
  1594.  
  1595. ALPHA1 = IPOE VDEF1 EVALPH3 LINE;
  1596.  
  1597.  
  1598.  
  1599. *
  1600. * --- Calcul du C de la loi de Mansson-Coffin
  1601. *
  1602. EVC1 = EVOL MANU 'T' (PROG 293 438 588 668 ) 'C' (PROG 5.77 6.3 3.56 0.72 );
  1603. EVC2 = EVOL MANU 'T' (PROG 293 438 588 668 ) 'C' (PROG 5.03 12.25 7.01 1.09 );
  1604.  
  1605. VALC1 = IPOE EVC1 TLIEU1 FIXE;
  1606. VALC2 = IPOE EVC2 TLIEU1 FIXE;
  1607.  
  1608. EVC3 = EVOL MANU 'VDEF' (PROG 1.81E-3 9.05E-3 ) 'C' (PROG VALC1 VALC2);
  1609.  
  1610. CA1 = IPOE VDEF1 EVC3 LINE;
  1611.  
  1612.  
  1613. *
  1614. * --- Calcul du nombre de cycles
  1615. *
  1616.  
  1617. NCYCLES1 = (CA1/EPSETOI1) ** (1. / ALPHA1) ;
  1618. NCYCLES2 = ENTI (NCYCLES1 + 1);
  1619. MESS '>@ARANGU> Temperature [K] : ' T1 ;
  1620. MESS '>@ARANGU> Deformation speed [S-1] : ' V1 ;
  1621. MESS '>@ARANGU> Rupture according to Aran-Gucer [cycles]: ' NCYCLES2 ;
  1622.  
  1623. MESS '-----------------------------------------------> exiting @ARANGU';
  1624. FINPROC NCYCLES1;
  1625.  
  1626. **** @BOWRI72
  1627. DEBPROC @BOWRI72 TAB_1*TABLE ;
  1628. *
  1629. *
  1630. * CALCUL DU FLUX CRITIQUE SUIVANT LA CORRELATION DE BOWRING
  1631. *23456789012345678901234567890123456789012345678901234567890123456789012
  1632. * 1 2 3 4 5 6 7
  1633. *
  1634. * --- entrees
  1635. *
  1636. INIVEAU1 = TAB_1.'NIVEAU' ;
  1637. D_DIAM1 = TAB_1.'D_DIAM' ;
  1638. L_LONG1 = TAB_1.'L_HEATED' ;
  1639. P_PRES1 = TAB_1.'P_IN' ;
  1640. V_VITE1 = TAB_1.'V_IN' ;
  1641. T_TEMP1 = TAB_1.'T_IN' ;
  1642. TEST1 = FAUX ;
  1643. SI (EXISTE TAB1 ANNULE_D_DEF);
  1644. SI TAB1.ANNULE_D_DEF ;
  1645. TEST1 = VRAI;
  1646. FINSI ;
  1647. FINSI ;
  1648.  
  1649. *
  1650. * --- racine
  1651. *
  1652. SI (INIVEAU1 >EG 2 ) ;
  1653. MESS '---------------------------------> calling @BOWRI72';
  1654. FINSI ;
  1655. PI = 3.14159;
  1656. LOGI_1 = EXISTE TAB_1 EPTSAT;
  1657. LOGI_2 = EXISTE TAB_1 ETHFG;
  1658. LOGI_3 = EXISTE TAB_1 ETRHOF;
  1659. LOGI_4 = EXISTE TAB_1 ETCPF;
  1660. SI (NON (LOGI_1 ET LOGI_2 ET LOGI_3 ET LOGI_4));
  1661. @TABEAU TAB_1 ;
  1662. FINSI ;
  1663.  
  1664. *
  1665. * --- Test du domaine de definition des entrees
  1666. *
  1667. G_VITE1 = V_VITE1 * (@IPOE TAB_1.ETRHOF T_TEMP1);
  1668.  
  1669. SI TEST1 ;
  1670. * - test sur la vitesse de l'eau
  1671. SI ((G_VITE1 < 136.) OU ( G_VITE1 > 18600.)) ;
  1672. MESS 'Vitesse massique : ' G_VITE1;
  1673. ERRE '@BOWRING -> Vitesse massique hors [136. , 18600.] (Kg/M2/S)';
  1674. FINSI ;
  1675.  
  1676. * - test sur le diametre
  1677. SI ((D_DIAM1 < 2.E-3) OU (D_DIAM1 > 450.E-3)) ;
  1678. MESS 'Diametre : ' D_DIAM1;
  1679. ERRE '@BOWRING -> Diametre hors [0.002 0.45] (M)' ;
  1680. FINSI ;
  1681.  
  1682. * - test sur la Pression
  1683. SI ((P_PRES1 < 1.E5) OU (P_PRES1 > 200.E5)) ;
  1684. MESS 'Pression : ' P_PRES1;
  1685. ERRE '@BOWRING -> Pression hors de [1.E5, 200.E5] (Pa) ' ;
  1686. FINSI ;
  1687.  
  1688. * - test sur la longueur chauffee
  1689. SI ((L_LONG1 < 0.15) OU (L_LONG1 > 3.7)) ;
  1690. MESS 'Longueur : ' L_LONG1;
  1691. ERRE '@BOWRING --> Longueur hors de [0.15,3.7](M) ' ;
  1692. FINSI ;
  1693.  
  1694. * Fin des tests sur les entrees de @BOWRI72
  1695. FINSI ;
  1696.  
  1697. T_SAT = @IPOE TAB_1.EPTSAT P_PRES1 ;
  1698.  
  1699. P1 = P_PRES1 / 6900000. ;
  1700. SI (INIVEAU1 >EG 2) ;
  1701. MESS 'P_PRIME : ' P1 ;
  1702. FINSI ;
  1703.  
  1704. SI (P1 &lt;EG 1.) ;
  1705. F1 = (((P1 ** 18.942) * (EXP (20.8 * (1. - P1)))) + 0.917) / 1.917;
  1706. F2 = (F1 * 1.309)/(((P1 ** 1.316)*(EXP(2.444*(1. - P1)))) + 0.309);
  1707. F3 = (((P1 ** 17.023)*(EXP(16.658*(1. - P1)))) + 0.667)/1.667;
  1708. F4 = F3 * (P1 ** 1.649) ;
  1709. SINON ;
  1710. F1 = (P1 ** (-0.368))*(EXP(0.648*(1. - P1)));
  1711. F2 = (P1 ** (-0.448))*(EXP(0.245*(1. - P1)));
  1712. F3 = P1 ** 0.219;
  1713. F4 = F3 * (P1 ** 1.649) ;
  1714. FINSI ;
  1715.  
  1716. SI (INIVEAU1 >EG 2) ;
  1717. MESS 'F1 : ' F1 ;
  1718. MESS 'F2 : ' F2 ;
  1719. MESS 'F3 : ' F3 ;
  1720. MESS 'F4 : ' F4 ;
  1721. FINSI ;
  1722.  
  1723.  
  1724. L_VAP = @IPOE TAB_1.ETHFG T_TEMP1 ;
  1725. CP__1 = @IPOE TAB_1.ETCPF T_TEMP1 ;
  1726.  
  1727. S_SAT = CP__1 * (T_SAT - T_TEMP1) ;
  1728.  
  1729. SI (INIVEAU1 >EG 2) ;
  1730. MESS 'L_VAP : ' L_VAP ;
  1731. MESS 'CP__1 : ' CP__1 ;
  1732. MESS 'S_SAT : ' S_SAT ;
  1733. FINSI ;
  1734.  
  1735. A__1 = 0.5793 * L_VAP * D_DIAM1 * G_VITE1 * F1 / (1. + (0.0143 * F2 * (D_DIAM1 ** .5) * G_VITE1 )) ;
  1736.  
  1737. B__1 = .25 * D_DIAM1 * G_VITE1 ;
  1738.  
  1739. C__1 = 0.077 * D_DIAM1 * G_VITE1 * F3 / (1. + (0.347 * F4 * ((G_VITE1/1356.) ** (2. - (.5 * P1))))) ;
  1740.  
  1741. SI (INIVEAU1 >EG 5) ;
  1742. MESS 'A : ' A__1 ;
  1743. MESS 'B : ' B__1 ;
  1744. MESS 'C : ' C__1 ;
  1745. FINSI ;
  1746.  
  1747. QCHFW = (A__1 + (B__1 * S_SAT)) / (C__1 + L_LONG1) ;
  1748.  
  1749. G1 = G_VITE1 * PI * D_DIAM1 * D_DIAM1 / 4. ;
  1750. *
  1751. * --- sortie de la procedure
  1752. *
  1753.  
  1754. SI ( INIVEAU1 >EG 1 ) ;
  1755. MESS '>>@BOWRI72>> TUBE DIAMETER (M) : ' D_DIAM1 ;
  1756. MESS '>>@BOWRI72>> TUBE LENGHT (M) : ' L_LONG1 ;
  1757. MESS '>>@BOWRI72>> MASS FLOW VELOCITY (KG/S/M2) : ' G_VITE1;
  1758. MESS '>>@BOWRI72>> INLET MASS FLOW RATE (KG/S) : ' G1 ;
  1759. MESS '>>@BOWRI72>> VELOCITY (M/S) : ' V_VITE1 ;
  1760. MESS '>>@BOWRI72>> FLUID INLET TEMPERATURE (C) : ' T_TEMP1 ;
  1761. MESS '>>@BOWRI72>> FLUID INLET PRESSURE (PA) : ' P_PRES1 ;
  1762. MESS '>>@BOWRI72>> WATER SATURATION TEMPERATURE(C) : ' T_SAT ;
  1763. MESS '>>@BOWRI72>> WALL CRITICAL HEAT FLUX (W/m2) : ' QCHFW ;
  1764. FINSI ;
  1765.  
  1766. SI (INIVEAU1 >EG 2 ) ;
  1767. MESS '---------------------------------> Sortie de @BOWRI72';
  1768. FINSI ;
  1769. *
  1770. * --- sorties
  1771. *
  1772. TAB1.CHF = QCHFW ;
  1773.  
  1774. FINPROC ;
  1775.  
  1776.  
  1777. debproc @calcflu mod1*mmodel cht1*chpoint mat1*chpoint ;
  1778.  
  1779. gradt1 = grad cht1 mod1 ;
  1780. flux1 = mat1 * gradt1 ;
  1781.  
  1782. finproc flux1 ;
  1783.  
  1784. **** @CALHCON
  1785. DEBPROC @CALHCON TAB_1*TABLE ;
  1786.  
  1787. *
  1788. * !!! R. MITTEAU !!! attention, procedure standard
  1789. *
  1790. * un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
  1791. * pour les mises a jour
  1792. *
  1793. *-------------------------------------------------------------------*
  1794. * *
  1795. * COEFFICIENT D ECHANGE TENANT COMPTE *
  1796. * DE L EBULLITION SOUS SATUREE *
  1797. * *
  1798. *-------------------------------------------------------------------*
  1799. *
  1800. DIAM = TAB_1 . D_MAQUETTE ;
  1801. TTAPE = TAB_1 . T_TAPE ;
  1802. YTW1 = TAB_1 . TWIST_RATIO ;
  1803. V1 = TAB_1 . V_LOCAL ;
  1804. *js 20/4/95 je change T_MOY en t_local ????
  1805. T_LOC1 = TAB_1 . 'T_LOCAL' ;
  1806. NIVEAU = TAB_1.'NIVEAU' ;
  1807. P_LOCAL1 = TAB_1.'P_LOCAL' ;
  1808. L1TRAC = TAB_1.'TRAC_GRAPHE' ;
  1809. *
  1810. SI (NIVEAU >EG 4) ;
  1811. MESS '-----------------------------------> calling @CALHCON ' ;
  1812. FINSI ;
  1813. *
  1814. *
  1815. PI = 3.14159 ;
  1816. *S1 = PI * DIAM * DIAM / 4. ;
  1817. SI ( NON ( EXISTE TAB_1 HYPERVAP ) ) ;
  1818. TAB_1.HYPERVAP = FAUX ;
  1819. FINSI ;
  1820. SI ( ( YTW1 EGA 0. 1.E-6 ) ET ( EGA TAB_1.HYPERVAP FAUX ) ) ;
  1821. S1 = PI * DIAM * DIAM / 4. ;
  1822. TAB_1.DH = DIAM ;
  1823. FACV = 1. ;
  1824. FACF = 1. ;
  1825. FINSI ;
  1826. SI ( NON ( EXISTE TAB_1 HELI_WIRE ) ) ;
  1827. TAB_1.HELI_WIRE = FAUX ;
  1828. FINSI ;
  1829. SI ( ( YTW1 EGA 0. 1.E-6 ) ET ( EGA TAB_1.HELI_WIRE VRAI ) ET ( EGA TAB_1.HYPERVAP FAUX ) ) ;
  1830. S1 = PI * DIAM * DIAM / 4. ;
  1831. SM = PI * TAB_1.WIRE_D * TAB_1.WIRE_D / 4. ;
  1832. P1 = PI * DIAM ;
  1833. PM = PI * TAB_1.WIRE_D ;
  1834. TAB_1.DH = 4. * ( S1 - SM ) / ( P1 + PM ) ;
  1835. PIS2Y = PI / ( 2 * TAB_1.PITCH_WIRE ) ;
  1836. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  1837. * FACV = 1. ;
  1838. FACF = 1. ;
  1839. FINSI ;
  1840. *
  1841. SI ( ( YTW1 EGA 0. 1.E-6 ) ET ( EGA TAB_1.HYPERVAP VRAI ) ) ;
  1842. SM = ( TAB_1 . LARG_CANAL * TAB_1 . HMIN_CANAL ) + ( 2. * ( TAB_1 . LARG_ESP * TAB_1 . HFIN ) ) ;
  1843. PM = TAB_1 . LARG_CANAL + ( 2.* TAB_1 . HMAX_CANAL ) + ( 2. * TAB_1 . LARG_ESP ) + ( 2. * TAB_1 . HFIN ) + TAB_1 . LFIN ;
  1844. TAB_1.DH = 4. * SM / PM ;
  1845. FACV = 1. ;
  1846. * FACF = 2.25 ;
  1847. * modif 261099 calcul du rapport Strue/Sapparent
  1848. * N CURT
  1849. SI (TAB_1.HFIN > 0. ) ;
  1850.  
  1851.  
  1852. S_E1 = ((4.*TAB_1.HFIN)+(2.*TAB_1.LARG_ESP)+(TAB_1.LFIN))* (TAB_1.FF + TAB_1.f0) ;
  1853. S_E2 = ((4.*TAB_1.HFIN)+(2.*TAB_1.LARG_ESP)+(TAB_1.LFIN))* (TAB_1.FF) ;
  1854. S_E3 = 2.* (TAB_1.LFIN * (TAB_1.HFIN - TAB_1.RFIN)) ;
  1855. S_E4 = PI * ( TAB_1.RFIN * TAB_1.LFIN) ;
  1856. S_E5 = 2. * (( TAB_1.HFIN + TAB_1.LARG_ESP) * TAB_1.f0) ;
  1857. S_E6 = TAB_1.RFIN * ((2.*TAB_1.f0)-(PI* TAB_1.RFIN)) ;
  1858. FACF = (S_E2+S_E3+S_E4+S_E5+S_E6)/ S_E1 ;
  1859. SINON ;
  1860. FACF = 1. ;
  1861. FINSI ;
  1862. *fin modif
  1863.  
  1864. TAB_1.FACCF = FACF ;
  1865. TAB_1.HYP_SM = SM ;
  1866. FINSI ;
  1867. SI ( YTW1 > 0. ) ;
  1868. QUAS = 4. * ( ( PI * DIAM * DIAM / 8.) - ( TTAPE * DIAM / 2. ) ) ;
  1869. PERI = ( ( PI * DIAM / 2.) - TTAPE + DIAM ) ;
  1870. TAB_1.DH = QUAS / PERI ;
  1871. PIS2Y = PI / ( 2. * YTW1 ) ;
  1872. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  1873. FACF = 1.15 ;
  1874. FINSI ;
  1875. SI ( EXISTE TAB_1 RIP_FLOWS ) ;
  1876. S1 = ( TAB_1 . RIP_FLOWS ) ;
  1877. FINSI ;
  1878. SI ( EXISTE TAB_1 RIP_WETP ) ;
  1879. PERI = ( TAB_1 . RIP_WETP ) ;
  1880. TAB_1.DH = 4. * S1 / PERI ;
  1881. FINSI ;
  1882. SI ( EXISTE TAB_1 RIP_TWIST ) ;
  1883. PIS2Y = PI / ( 2. *( TAB_1 . RIP_TWIST ) ) ;
  1884. FACV2 = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  1885. FACV = MAXI ( PROG FACV FACV2 ) ;
  1886. FINSI ;
  1887.  
  1888. SI ( EGA TAB_1.HYPERVAP FAUX ) ;
  1889. FACD = ( DIAM / TAB_1.DH ) ** 0.2 ;
  1890. FACT = ( FACV ** 0.8 ) * FACD * FACF ;
  1891. SINON ;
  1892. FACD = 1. ;
  1893. FACT = ( FACV ** 0.8 ) * FACD * FACF ;
  1894. FINSI ;
  1895. * modif pour calcul W7x provisoire
  1896. * adaptation du coef correctif W7X du au swirl
  1897. * N CURT 18012000
  1898. * SI ( EGA TAB_1.HYPERVAP FAUX ) ;
  1899. * SI (YTW1 > 0. ) ;
  1900. * FACF = 2.18 * ((YTW1)**(-1 * 0.09)) ;
  1901. * FACF = 2.26 * ((YTW1)**(-1 * 0.248)) ;
  1902. * FACD = 1. ;
  1903. * FACV = 1. ;
  1904. * FACT = ( FACV ** 0.8 ) * FACD * FACF ;
  1905. * SINON ;
  1906. *FACD = ( DIAM / TAB_1.DH ) ** 0.2 ;
  1907. * FACT = ( FACV ** 0.8 ) * FACD * FACF ;
  1908. * FINSI ;
  1909. * SINON ;
  1910. * FACD = 1. ;
  1911. * FINSI ;
  1912. * fin modif
  1913. *
  1914. * attention modification par R. MITTEAU le 7 fevrier 1994
  1915. * j'ai rajoute les " FIXE " pour pouvoir passer un calcul
  1916. * dans lequel l'eau est quasi immobile. Car dans ce cas les valeurs
  1917. * sont en dehors des tables
  1918.  
  1919. * avant modif
  1920. *TSAT = @IPOE P_LOCAL1 TAB_1.EPTSAT ;
  1921. *NNU = @IPOE T_LOC1 TAB_1.ETNNU ;
  1922. *RHO = @IPOE T_LOC1 TAB_1.ETRHOF ;
  1923. *PR = @IPOE T_LOC1 TAB_1.ETPRAF ;
  1924. *LLAM = @IPOE T_LOC1 TAB_1.ETLLA ;
  1925. *NNUB = @IPOE T_LOC1 TAB_1.ETNNU ;
  1926.  
  1927. * apres modif raph
  1928. *MESS '>>PRESS T_MOY S1' P_LOCAL T_LOC1 ;
  1929. TSAT = @IPOE P_LOCAL1 TAB_1.EPTSAT FIXE ;
  1930. NNU = @IPOE T_LOC1 TAB_1.ETNNU FIXE ;
  1931. RHO = @IPOE T_LOC1 TAB_1.ETRHOF FIXE ;
  1932. PR = @IPOE T_LOC1 TAB_1.ETPRAF FIXE ;
  1933. LLAM = @IPOE T_LOC1 TAB_1.ETLLA FIXE ;
  1934. NNUB = @IPOE T_LOC1 TAB_1.ETNNU FIXE ;
  1935.  
  1936. *
  1937. RE = RHO * ( NNU ** -1 ) * V1 * TAB_1.DH * FACV ;
  1938. *
  1939. SI ( T_LOC1 < TSAT ) ;
  1940. LTWALL1 = PROG -52. pas 25. (T_LOC1 + 0.01) pas 25. TSAT pas 25. 350. 400. 450. 500. 1500. 2550. 3000. 3500. 20000. ;
  1941. SINON ;
  1942. LTWALL1 = PROG -52. pas 25. TSAT pas 25. 350. 400. 450. 500. 1500. 2550. 3000. 3500. 20000. ;
  1943. FINSI ;
  1944. *
  1945. LNNUW = @IPOE LTWALL1 TAB_1.ETNNU 'FIXE' ;
  1946. *modif NCURT 10012000
  1947. *calcul nb de Prandtl sur le mur
  1948. LPRW = @IPOE LTWALL1 TAB_1.ETPRAF 'FIXE' ;
  1949. *fin modif
  1950. LTETA = PROG ( DIME LTWALL1 ) * T_LOC1 ;
  1951. *
  1952. LM_ITETA = LTWALL1 MASQUE 'INFERIEUR' T_LOC1 ;
  1953. LM_STETA = LTWALL1 MASQUE 'EGSUP' T_LOC1 ;
  1954. *
  1955. *SI ( EGA TAB_1.L_CONVECT 'DITTUS_BOELTER' ) ;
  1956. NUS_2 = FACF * 0.023 * ( RE ** 0.8 ) * ( PR ** 0.4 ) ;
  1957. NUS_1 = FACF * 0.023 * ( RE ** 0.8 ) * ( PR ** 0.3 ) ;
  1958. LNUS_2 = PROG ( DIME LTWALL1 ) * NUS_2 ;
  1959. LNUS_1 = PROG ( DIME LTWALL1 ) * NUS_1 ;
  1960. LNUS = ( LNUS_1 * LM_ITETA ) + ( LNUS_2 * LM_STETA ) ;
  1961. LH_DB = LNUS * LLAM / TAB_1.DH ;
  1962. LFC_DB = ( LTWALL1 - LTETA ) * LH_DB;
  1963. TITRE 'DITTUS_BOELTER' ;
  1964. EVOFC_DB = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_DB ;
  1965. *FINSI ;
  1966. *
  1967. *SI ( EGA TAB_1.L_CONVECT 'SIEDER_TATE' ) ;
  1968. NUS1 = FACF * 0.027 * ( RE ** 0.8 ) * ( PR ** ( 1. / 3. )) ;
  1969. LNUS = ( ( LNNUW / NNUB ) ** -0.14 ) * NUS1 ;
  1970. LH_ST = LNUS * ( LLAM / TAB_1.DH ) ;
  1971. LFC_ST = ( LTWALL1 - LTETA ) * LH_ST ;
  1972. TITRE 'SIEDER_TATE' ;
  1973. EVOFC_ST = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_ST ;
  1974. *FINSI ;
  1975. *
  1976. *SI ( EGA TAB_1.L_CONVECT 'PETHUKOV' ) ;
  1977. F_P = (1. / ( 1.82 * ( ( LOG RE ) / ( LOG 10.) ) - 1.64 )) ** 2 ;
  1978. X_P = 1.07 + (12.7 * (PR ** (2. / 3.) - 1.) * ( (F_P / 8.) ** 0.5 ));
  1979. NUS1 = ( RE * PR * F_P ) / ( X_P * 8. ) ;
  1980. LNUS_2 = ( ( LNNUW / NNUB ) ** -0.11 ) * FACF * NUS1 ;
  1981. LNUS_1 = ( ( LNNUW / NNUB ) ** -0.25 ) * FACF * NUS1 ;
  1982. LNUS = (LNUS_1 * LM_ITETA) + (LNUS_2 * LM_STETA) ;
  1983. LH_P = LNUS * ( LLAM /TAB_1.DH ) ;
  1984. LFC_P = ( LTWALL1 - LTETA ) * LH_P ;
  1985. TITRE 'PETHUKOV' ;
  1986. EVOFC_P = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_P ;
  1987. *FINSI ;
  1988.  
  1989.  
  1990.  
  1991. *modif NCURT 10012000
  1992. *adaptation de la correlation non courte de Gnielinski
  1993. *cf Greuner 260499
  1994. *SI ( EGA TAB_1.L_CONVECT 'GNIELINSKI' ) ;
  1995. F_G = (1. / (1.82 * ( ( LOG RE ) / ( LOG 10.)) - 1.64 )) ** 2 ;
  1996. R_G = ( (PR ** (2. / 3.)) - 1.) * ( (F_G / 8.) ** 0.5) ;
  1997. X_G = 1. + (12.7 * R_G);
  1998. NUS3 = FACF * (((RE - 1000.)* PR) * F_G) / ( X_G * 8.) ;
  1999. * correlation courte
  2000. * NUS3 = FACF * 0.012 * ((RE ** 0.87) - 280. ) * (PR ** 0.4) ;
  2001. LNUS = ( ( LPRW / PR ) ** -0.11 ) * NUS3 ;
  2002. LH_GN = LNUS * ( LLAM/TAB_1.DH) ;
  2003. LFC_GN = ( LTWALL1 - LTETA ) * LH_GN ;
  2004. TITRE 'GNIELINSKI' ;
  2005. EVOFC_GN = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_GN ;
  2006.  
  2007. *fin modif
  2008.  
  2009.  
  2010. *SI ( EGA TAB_1.L_CONVECT 'JB_CONVEC' ) ;
  2011. SI (NON ( YTW1 EGA 0. 1.E-6 ) ) ;
  2012. FACFJB = 1. + ( 0.7 / YTW1 ) ;
  2013. SINON ;
  2014. FACFJB = 1. ;
  2015. FINSI ;
  2016. NUS_3 = FACFJB * 0.023 * ( RE ** 0.8 ) * ( PR ** 0.4 ) ;
  2017. LNUS = ( ( LNNUW / NNUB ) ** -0.25 ) * NUS_3 ;
  2018. LH_JB = LNUS * ( LLAM / TAB_1.DH ) ;
  2019. LFC_JB = ( LTWALL1 - LTETA ) * LH_JB ;
  2020. TITRE 'JB_CONVEC' ;
  2021. EVOFC_JB = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_JB ;
  2022. *FINSI ;
  2023. *
  2024. SI ( NON ( EXISTE TAB_1 L_CONVECT ) ) ;
  2025. *js TAB_1.L_CONVECT = 'DITTUS_BOELTER' ;
  2026. TAB_1.L_CONVECT = 'SIEDER_TATE' ;
  2027. FINSI ;
  2028. *
  2029. SI ( EGA TAB_1.L_CONVECT 'DITTUS_BOELTER' ) ;
  2030. LHCONV = LH_DB ;
  2031. FINSI ;
  2032. *
  2033. SI ( EGA TAB_1.L_CONVECT 'SIEDER_TATE' ) ;
  2034. LHCONV = LH_ST ;
  2035. FINSI ;
  2036. *
  2037. SI ( EGA TAB_1.L_CONVECT 'PETHUKOV' ) ;
  2038. LHCONV = LH_P ;
  2039. FINSI ;
  2040. *
  2041. SI ( EGA TAB_1.L_CONVECT 'JB_CONVEC') ;
  2042. LHCONV = LH_JB ;
  2043. FINSI ;
  2044.  
  2045. *modif 10012000
  2046. SI ( EGA TAB_1.L_CONVECT 'GNIELINSKI') ;
  2047. LHCONV = LH_GN ;
  2048. FINSI ;
  2049. *fin modif
  2050.  
  2051. *
  2052. * Calculation of TONB FONB Bergles & Rohsenow correlation
  2053. *
  2054. IONB = 0 ;
  2055. TB1 = TSAT + 15. ;
  2056. REPETER BOUCONB ;
  2057. IONB = IONB + 1 ;
  2058. SI ( IONB > 7 ) ;
  2059. QUITTER BOUCONB ;
  2060. FINSI ;
  2061. PRATIO = P_LOCAL1 * 1.E-5 ;
  2062. EXPO1 = 1. / ( 0.463 * ( PRATIO ** 0.0234 ) ) ;
  2063. DUM = ( 1. / 0.556 ) * ( TB1 - TSAT ) ;
  2064. FTBA = 1082. *( PRATIO ** 1.156 )* ( DUM ** EXPO1 ) ;
  2065. HCONV = IPOL TB1 LTWALL1 LHCONV ;
  2066. FTB = ( HCONV * ( TB1 - T_LOC1 ) ) - FTBA ;
  2067. ;
  2068. * **** CALCUL DE LA DERIVEE PAR RAPPORT A TB1-TETA **********
  2069. FTB1 = HCONV - ( ( EXPO1 * FTBA ) / ( TB1 - TSAT ) ) ;
  2070. * **** CALCUL DU NOUVEAU TB **********
  2071. TONB = TB1 - ( FTB / FTB1 ) ;
  2072. SI ( ( ABS ( TONB -TB1 ) ) &lt;EG 0.1 ) ;
  2073. QUITTER BOUCONB ;
  2074. FINSI ;
  2075. TB1 = TONB ;
  2076. FIN BOUCONB ;
  2077. MESS '>@CALHCON> TONB VALUE BY BERG.& ROHS. CORREL.: ' TONB ;
  2078. MESS '>@CALHCON> TONB PRECISION : ' ((TONB - TB1) / TONB);
  2079. *
  2080. *
  2081. SI ( T_LOC1 < TSAT ) ;
  2082. 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 ;
  2083. SINON ;
  2084. LTWALL2 = PROG -52. pas 25. TSAT pas 5. (TONB + 0.01) pas 5. (TONB + 50.) pas 25. 450. 500. 1500. 3000. 2.1E4 ;
  2085. FINSI ;
  2086.  
  2087. LTWALL = LTWALL2 ;
  2088. *
  2089. LHCONV = @ITPLT LTWALL1 LHCONV 'FIXE' LTWALL2 ;
  2090. LTETA = PROG ( DIME LTWALL ) * T_LOC1 ;
  2091. LTSAT = PROG ( DIME LTWALL ) * TSAT ;
  2092. LTONB = PROG ( DIME LTWALL ) * TONB ;
  2093. *
  2094. LM_ITSAT = LTWALL MASQUE 'INFERIEUR' TSAT ;
  2095. LM_STSAT = LTWALL MASQUE 'EGSUPE' TSAT ;
  2096. LM_ITONB = LTWALL MASQUE 'INFERIEUR' TONB ;
  2097. LM_STONB = LTWALL MASQUE 'EGSUPE' TONB ;
  2098. LM_ITON1 = LTWALL MASQUE 'EGINFE' TONB ;
  2099. LM_STON1 = LTWALL MASQUE 'SUPERIEUR' TONB ;
  2100. *
  2101. *SI ( EGA TAB_1.L_SUBNB 'THOM' ) ;
  2102. VEXPTM = EXP ( 1.E-5 * P_LOCAL1 / 87. ) ;
  2103. LFB_TM = ( LTWALL - LTSAT ) * ( VEXPTM / 22.65 ) ;
  2104. LFB_TM = ( LFB_TM ** 2 ) * 1.E6 ;
  2105. LFB_TM = LFB_TM * LM_STSAT ;
  2106. TITRE 'THOM' ;
  2107. EVOFB_TM = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TM ;
  2108. EVOFB_T1 = EVOFB_TM ;
  2109. *FINSI ;
  2110. *
  2111. SI ( NON ( EXISTE TAB_1 L_SUBNB ) ) ;
  2112. TAB_1.L_SUBNB = 'THOM_CEA' ;
  2113. SI ( NON ( EXISTE TAB_1 V_EXPTHOM ) ) ;
  2114. TAB_1 . V_EXPTHOM = 2.8 ;
  2115. FINSI ;
  2116. FINSI ;
  2117. *
  2118. SI ( EGA TAB_1.L_SUBNB 'THOM_CEA' ) ;
  2119. VEXPTM = EXP ( 1.E-5 * P_LOCAL1 / 87. ) ;
  2120. LFB_TM = ( LTWALL - LTSAT ) * ( VEXPTM / 22.65 ) ;
  2121. E_TMP = TAB_1.V_EXPTHOM / 2. ;
  2122. LFB_TMP = (( LFB_TM ** 2 ) ** E_TMP) * 1.E6 ;
  2123. LFB_TMP = LFB_TMP * LM_STSAT ;
  2124. TITRE 'THOM_CEA' ;
  2125. EVFB_TMP = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TMP ;
  2126. EVOFB_T1 = EVOFB_T1 ET EVFB_TMP ;
  2127. FINSI ;
  2128. *
  2129. SI ( EGA TAB_1.L_SUBNB 'T_JAERI' ) ;
  2130. VEXPTM = EXP ( 1.E-5 * P_LOCAL1 / 87. ) ;
  2131. LFB_TM = ( LTWALL - LTSAT ) * ( VEXPTM / 25.72 ) ;
  2132. E_TMJ = 3 / 2. ;
  2133. LFB_TMJ = (( LFB_TM ** 2 ) ** E_TMJ) * 1.E6 ;
  2134. LFB_TMJ = LFB_TMJ * LM_STSAT ;
  2135. TITRE 'T_JAERI' ;
  2136. EVFB_TMJ = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TMJ ;
  2137. EVOFB_T1 = EVOFB_T1 ET EVFB_TMJ ;
  2138. FINSI ;
  2139. *
  2140. *SI ( EGA TAB_1.L_SUBNB 'JENS_LOTTES' ) ;
  2141. VEXPJL = EXP ( 1.E-5 * P_LOCAL1 / 62. ) ;
  2142. LFB_JL = ( LTWALL - LTSAT ) * ( VEXPJL / 25. ) ;
  2143. LFB_JL = ( LFB_JL ** 4 ) * 1.E6 ;
  2144. LFB_JL = LFB_JL * LM_STSAT ;
  2145. TITRE 'JENS_LOTTES' ;
  2146. EVOFB_JL = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_JL ;
  2147. *FINSI ;
  2148. *
  2149. SI ( EGA TAB_1.L_SUBNB 'YIN' ) ;
  2150. D_YIN1 = 7.195 * ( TAB_1.GAM_YIN ** 1.82 ) ;
  2151. D_YIN2 = ( 1.E-5 * P_LOCAL1 ) ** 0.072 ;
  2152. LFB_YIN = ( 1.E6 * ( LTWALL - LTSAT ) ) / ( D_YIN1 * D_YIN2 ) ;
  2153. LFB_YIN = LFB_YIN * LM_STSAT ;
  2154. TITRE 'YIN' ;
  2155. EVFB_YIN = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_YIN ;
  2156. FINSI ;
  2157. *
  2158. TAC1 = TABLE ;
  2159. TAC1.1 = 'MARQ CROI REGU' ;
  2160. TAC1.2 = 'MARQ PLUS REGU' ;
  2161. TAC1.3 = 'MARQ ETOI REGU' ;
  2162. TAC1.4 = 'MARQ LOSA REGU' ;
  2163. TAC1.5 = 'MARQ CARR REGU' ;
  2164. TAC1.6 = 'MARQ TRIB REGU' ;
  2165. *
  2166. TAC2 = TABLE ;
  2167. TAC2.1 = 'MARQ CARR REGU' ;
  2168. TAC2.2 = 'MARQ LOSA REGU' ;
  2169. TAC2.3 = 'MARQ TRIA REGU' ;
  2170. TAC2.4 = 'MARQ TRIB REGU' ;
  2171. *
  2172. MESS '>@CALHCON> VELOCITY (M/S) : ' V1 ;
  2173.  
  2174. * MESS '>@CALHCON> MASS FLOW RATE ( KG/S ) : '
  2175. * (V1 * S1 * RHO) ;
  2176. MESS '>@CALHCON> FLUID TEMPERATURE (C) : ' T_LOC1 ;
  2177. MESS '>@CALHCON> FLUID PRESSURE ( PA ) : ' P_LOCAL1 ;
  2178. MESS '>@CALHCON> WATER SATURATION TEMPERATURE(C) : ' TSAT ;
  2179. *MESS '>@CALHCON> TUBE DIAMETER (M) : ' DIAM ;
  2180. MESS '>@CALHCON> TUBE HYDRAULIC DIAMETER (M) : ' TAB_1.DH ;
  2181. MESS '>@CALHCON> SWIRL TAPE THICKNESS (M) : ' TTAPE ;
  2182. MESS '>@CALHCON> TWIST RATIO : ' YTW1 ;
  2183. MESS '>@CALHCON> FLUID DENSITY ( KG/M**3) : ' RHO ;
  2184. MESS '>@CALHCON> FLUID CONDUCTIVITY ( W/M.K) : ' LLAM ;
  2185. MESS '>@CALHCON> REYNOLDS NUMBER : ' RE ;
  2186. MESS '>@CALHCON> FLUID VISCOSITY (KG/M.S) : ' NNU ;
  2187. MESS '>@CALHCON> PRANDTL NUMBER : ' PR ;
  2188. MESS '>@CALHCON> FACTOR DUE TO FIN EFFECT : ' FACF ;
  2189. MESS '>@CALHCON> FACTOR DUE TO CHANGE ON HYD.DIAM: ' FACD ;
  2190. *MESS '>@CALHCON> FACTOR DUE TO TWISTED VELOCITY : ' FACV ;
  2191. MESS '>@CALHCON> VELOCITY CORRECTION FACTOR : 'FACV ;
  2192. MESS '>@CALHCON> TOTAL FACT. DUE TO TWIST or RIP.: ' FACT ;
  2193. MESS '>@CALHCON> NUSS. HEATING NUMBER : ' ( IPOL 400. LTWALL1 LNUS ) ;
  2194. *MESS ' EXPERIMENTAL CRITICAL FLUX : ' FCR1 ;
  2195. MESS '>@CALHCON> CONV. COEF. (CONVECTION) : ' ( IPOL 400. LTWALL1 LH_DB ) ;
  2196. MESS '>@CALHCON> FC_DB (TWALL = 400 C ) :' ( IPOL 400. LTWALL1 LFC_DB ) ;
  2197. *
  2198. *
  2199. *
  2200. SI ( EGA TAB_1.L_SUBNB 'THOM' ) ;
  2201. LFB = LFB_TM ;
  2202. FINSI ;
  2203. *
  2204. SI ( EGA TAB_1.L_SUBNB 'THOM_CEA' ) ;
  2205. LFB = LFB_TMP ;
  2206. FINSI ;
  2207. *
  2208. SI ( EGA TAB_1.L_SUBNB 'T_JAERI' ) ;
  2209. LFB = LFB_TMJ ;
  2210. FINSI ;
  2211. *
  2212. SI ( EGA TAB_1.L_SUBNB 'JENS_LOTTES' ) ;
  2213. LFB = LFB_JL ;
  2214. FINSI ;
  2215. *
  2216. SI ( EGA TAB_1.L_SUBNB 'YIN' ) ;
  2217. LFB = LFB_YIN ;
  2218. TAB_1.CONNECT_METHOD = 'ADDITION' ;
  2219. FINSI ;
  2220. *
  2221. SI ( EXISTE TAB_1 AMPL_H ) ;
  2222. LHCONV = LHCONV * ( TAB_1 . AMPL_H ) ;
  2223. FINSI ;
  2224. *
  2225. LFCONV = ( LTWALL - LTETA ) * LHCONV ;
  2226. TITRE TAB_1.L_CONVECT 'CONVECTION FLUX' ;
  2227. EVOFC = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFCONV ;
  2228. TITRE TAB_1.L_SUBNB 'BOILING FLUX' ;
  2229. EVOFE = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFB ;
  2230. *
  2231. SI ( NON ( EXISTE TAB_1 CONNECT_METHOD ) ) ;
  2232. TAB_1.CONNECT_METHOD = 'BERG_ROH' ;
  2233. FINSI ;
  2234. *
  2235. SI ( EGA TAB_1.CONNECT_METHOD 'ADDITION' ) ;
  2236. TAB_1.L_SUBNB = 'YIN' ;
  2237. MESS '>@CALHCON> ADDITION DE FSPL ET FSCB CHOISIE ' ;
  2238. LFT = LFCONV + LFB ;
  2239. FINSI ;
  2240. *
  2241. SI ( EGA TAB_1.CONNECT_METHOD 'DIRECT' ) ;
  2242. PA_TEMPE = 10. ;
  2243. TEMPE_PA = TSAT ;
  2244. FLUX_DIC = @IPOE TEMPE_PA EVOFC ;
  2245. FLUX_DIE = @IPOE TEMPE_PA EVOFE ;
  2246. * Recherche du point d'intersection
  2247. REPETER BOUC_DIR ;
  2248. SI ( ( ABS ( FLUX_DIE - FLUX_DIC ) ) &lt;EG 1.E2 ) ;
  2249. QUITTER BOUC_DIR ;
  2250. FINSI ;
  2251. SI ( FLUX_DIE > FLUX_DIC ) ;
  2252. TEMPE_PA = TEMPE_PA - PA_TEMPE ;
  2253. PA_TEMPE = PA_TEMPE / 2. ;
  2254. FINSI ;
  2255. TEMPE_PA = TEMPE_PA + PA_TEMPE ;
  2256. FLUX_DIC = @IPOE TEMPE_PA EVOFC ;
  2257. FLUX_DIE = @IPOE TEMPE_PA EVOFE ;
  2258. FIN BOUC_DIR ;
  2259. RANGE_D = (LTWALL MASQUE 'INFE' 'SOMME' TEMPE_PA) + 1 ;
  2260. LTWALL_D = INSERER LTWALL RANGE_D TEMPE_PA ;
  2261. LFCONV_D = INSERER LFCONV RANGE_D FLUX_DIC ;
  2262. LFB_D = INSERER LFB RANGE_D FLUX_DIE ;
  2263. LM_IFLUX = LFCONV_D MASQUE 'INFERIEUR' FLUX_DIC ;
  2264. LM_SFLUX = LFB_D MASQUE 'EGSUPE' FLUX_DIE ;
  2265. LFCONVI = LFCONV_D * LM_IFLUX ;
  2266. LFBS = LFB_D * LM_SFLUX ;
  2267. LFT = LFCONVI + LFBS ;
  2268. LTWALL = LTWALL_D ;
  2269. LFCONV = LFCONV_D ;
  2270. LFB = LFB_D ;
  2271. LTETA = PROG ( DIME LTWALL_D ) * T_LOC1 ;
  2272. FINSI ;
  2273. *
  2274. SI ( EGA TAB_1.CONNECT_METHOD 'BERG_ROH' ) ;
  2275. LFCONV1 = LFCONV * LM_ITONB ;
  2276. LFCONV2 = LFCONV * LM_STONB ;
  2277. FB_ONB = IPOL TONB LTWALL LFB ;
  2278. LFB_ONB = PROG (DIME LTWALL) * FB_ONB ;
  2279. LDFB = ( LFB - LFB_ONB ) * LM_STONB ;
  2280. LF = ( LFCONV2 ** 2 ) + ( LDFB ** 2 ) ;
  2281. LF = LF ** 0.5 ;
  2282. LF = LF * LM_STONB ;
  2283. LFT = LFCONV1 + LF ;
  2284. FINSI ;
  2285. *
  2286. SI ( EGA TAB_1.CONNECT_METHOD 'JB_METHOD' ) ;
  2287. *
  2288. *liaison par flux = a Tparoi**10 + b
  2289. * LA_1 = ( LFB_ONB1 - LFB_ONB ) / (( LTONB1 ** 10 ) -
  2290. * ( LTONB ** 10 ) ) ;
  2291. * LB_1 = LFB_ONB - ( LA_1 * ( LTONB ** 10 ) ) ;
  2292. * LFPB = ( LA_1 * ( LTWALL_6 ** 10 ) ) + LB_1 ;
  2293. *
  2294. FB_ONB4 = IPOL TONB LTWALL LFB ;
  2295. FB_ONB5 = IPOL TONB LTWALL LFCONV ;
  2296. FB_ONB6 = 2.8 * FB_ONB5 ;
  2297. * EVFB_TMP = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TMP ;
  2298. EVFB_TM1 = EVOL MANU 'FLUX' LFB_TMP 'TEMPERATURE' LTWALL ;
  2299. T_ONB6 = @IPOE FB_ONB6 EVFB_TM1 FIXE ;
  2300. RANGE_6 = ( LTWALL MASQUE 'INFE' 'SOMME' T_ONB6 ) + 1 ;
  2301. LTWALL_6 = INSERER LTWALL RANGE_6 T_ONB6 ;
  2302. *
  2303. LM_ITON2 = LTWALL_6 MASQUE 'INFERIEUR' T_ONB6 ;
  2304. LM_STON2 = LTWALL_6 MASQUE 'EGSUPE' T_ONB6 ;
  2305. LM_ITON3 = LTWALL_6 MASQUE 'INFERIEUR' TONB ;
  2306. LM_STON3 = LTWALL_6 MASQUE 'EGSUPE' TONB ;
  2307. LFB_ONB4 = PROG ( DIME LTWALL_6 ) * FB_ONB4 ;
  2308. LFB_ONB6 = PROG ( DIME LTWALL_6 ) * FB_ONB6 ;
  2309. LTETA1 = PROG ( DIME LTWALL_6 ) * T_LOC1 ;
  2310. *
  2311. LHCONV1 = @ITPLT LTWALL LHCONV 'FIXE' LTWALL_6 ;
  2312. LFCONV1 = ( LTWALL_6 - LTETA1 ) * LHCONV1 ;
  2313. LFB1 = @ITPLT LTWALL LFB 'FIXE' LTWALL_6 ;
  2314. LFCONV2 = LFCONV1 * LM_ITON3 ;
  2315. LFCONV3 = LFCONV1 * LM_STON3 ;
  2316. LFCONV3 = LFCONV3 * LM_ITON2 ;
  2317. LB_1 = ( ( LFB_ONB6 ** 2 ) - ( LFCONV3 ** 2 ) ) / ( ( LFB_ONB6 - LFB_ONB4 ) ** 2 ) ;
  2318. * LB_1 = 1. ;
  2319. LDFB1 = ( LFB1 - LFB_ONB4 ) * LM_STON3 ;
  2320. LFT0 = ( LFCONV3 ** 2 ) + ( LB_1 * ( LDFB1 ** 2 ) ) ;
  2321. LFT0 = LFT0 ** 0.5 ;
  2322. LFT0 = LFT0 * LM_STON3 ;
  2323. LFT1 = LFCONV2 + LFT0 ;
  2324. FINSI ;
  2325. *
  2326. SI ( NON ( EXISTE TAB_1 PFIXTONB ) ) ;
  2327. TAB_1 . PFIXTONB = FAUX ;
  2328. FINSI ;
  2329. *
  2330. SI ( TAB_1 . PFIXTONB ) ;
  2331. F_ONB1 = IPOL TONB LTWALL LFT ;
  2332. LF_ONB1 = PROG (DIME LTWALL) * F_ONB1 ;
  2333. LHT = (LFT - LF_ONB1) / (LTWALL - LTONB) ;
  2334. LTETA_1 = LTONB - ( LF_ONB1 / LHT ) ;
  2335. MESS '>@CALHCON> LTETA_1 :' ;
  2336. TAB_1 . EV_TETA = EVOL MANU 'TEMPERATURE' LTWALL 'TEMPEAU' LTETA_1 ;
  2337. SINON ;
  2338. SI ( EGA TAB_1.CONNECT_METHOD 'JB_METHOD' ) ;
  2339. LFT = LFT1 ;
  2340. LHT = LFT1 / (LTWALL_6 - LTETA1 ) ;
  2341. LTWALL = LTWALL_6 ;
  2342. SINON ;
  2343. LHT = LFT / ( LTWALL - LTETA ) ;
  2344. FINSI ;
  2345. FINSI ;
  2346.  
  2347. TITRE ' HEAT TRANSFER COEFFICIENT ' ;
  2348. EVOCON = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LHT ;
  2349. *TITRE TAB_1.L_CONVECT 'CONVECTION FLUX' ;
  2350. *EVOFC = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFCONV ;
  2351. *TITRE TAB_1.L_SUBNB 'BOILING FLUX' ;
  2352. *EVOFE = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFB ;
  2353. TITRE ' COMBINED FLUX ' ;
  2354. EVOFT = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFT ;
  2355. *
  2356. TITRE ' COEF. D ECHANGE EN EBULLITION SOUS SATUREE, TONB :' TONB ;
  2357. *TITRE ' HEAT TRANSFER COEFFICIENT , TONB ' TONB ;
  2358. TITRE ' CHOSEN CORRELATIONS , TONB ' TONB ;
  2359.  
  2360. * modif raph/schlo pour couper l'echange au dessus du flux critique
  2361. * en regime transitoire, effectuee par R. MITTEAU le 16 fevrier 94
  2362. SI (EXISTE TAB_1 TRANSITOIRE) ;
  2363. SI TAB_1.TRANSITOIRE ;
  2364. SI (EXISTE TAB_1 FLUCRIT1 ) ;
  2365. EVBIDON1 = EVOL MANU LFT LTWALL ;
  2366. T_CRISE = @IPOE TAB_1.FLUCRIT1 EVBIDON1 ;
  2367. H_CRISE = @IPOE T_CRISE EVOCON ;
  2368. RANGENTI = ( LTWALL MASQUE 'INFE' 'SOMME' T_CRISE ) + 1 ;
  2369. LTWALL3 = INSERER LTWALL RANGENTI T_CRISE ;
  2370. LHT2 = INSERER LHT RANGENTI H_CRISE ;
  2371. LFT2 = INSERER LFT RANGENTI TAB_1.FLUCRIT1 ;
  2372. MASQ1 = LFT2 MASQUE EGINFE TAB_1.FLUCRIT1 ;
  2373. MASQ2 = LFT2 MASQUE SUPERIEUR TAB_1.FLUCRIT1 ;
  2374. LHT3 = (LHT2 * MASQ1 ) + MASQ2 ;
  2375. LFT3 = (LFT2 * MASQ1 ) + MASQ2 ;
  2376. TITRE ' HEAT TRANSFER COEFFICIENT ' ;
  2377. EVOCON = EVOL MANU 'TEMPERATURE' LTWALL3 'CONVECTION' LHT3 ;
  2378. TITRE ' COMBINED FLUX ' ;
  2379. EVOFT = EVOL MANU 'TEMPERATURE' LTWALL3 'CONVECTION' LFT3 ;
  2380. FINSI ;
  2381. FINSI ;
  2382. FINSI ;
  2383. *
  2384. TAB_1.T_SAT = TSAT ;
  2385. TAB_1.V_TONB = TONB ;
  2386. TAB_1.ECONVEC1 = EVOCON ;
  2387. TAB_1.EVOFE1 = EVOFE ;
  2388. *
  2389. TAC1 = TABLE ;
  2390. TAC1.1 = 'MARQ CROI REGU' ;
  2391. TAC1.2 = 'MARQ PLUS REGU' ;
  2392. TAC1.3 = 'MARQ ETOI REGU' ;
  2393. TAC1.4 = 'MARQ LOSA REGU' ;
  2394. TAC1.5 = 'MARQ CARR REGU' ;
  2395. TAC1.6 = 'MARQ TRIB REGU' ;
  2396. *
  2397. TAC2 = TABLE ;
  2398. TAC2.1 = 'MARQ CARR REGU' ;
  2399. TAC2.2 = 'MARQ LOSA REGU' ;
  2400. TAC2.3 = 'MARQ TRIA REGU' ;
  2401. TAC2.4 = 'MARQ TRIB REGU' ;
  2402. *
  2403. SI ( NON ( EXISTE TAB_1 C_TRACE ) ) ;
  2404. TAB_1.C_TRACE = FAUX ;
  2405. FINSI ;
  2406. *
  2407. SI L1TRAC ;
  2408. SI TAB_1.C_TRACE ;
  2409. SI ( EGA TAB_1.L_SUBNB 'YIN' ) ;
  2410. TITRE 'CONVECTIVE AND SUBCOOLED BOILING CORRELATIONS' ;
  2411. 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 ;
  2412. SINON ;
  2413. TITRE 'CONVECTIVE AND SUBCOOLED BOILING CORRELATIONS' ;
  2414. DESSIN ( EVOFC_DB ET EVOFC_ST ET EVOFC_P ET EVOFB_T1 ET EVOFB_JL) XBOR 0. 400. YBOR 0. 7.E7 LEGE TAC1 ;
  2415. TAB_1.EVOFC_D1 = EVOFC_DB ;
  2416. TAB_1.EVOFC_S1 = EVOFC_ST ;
  2417. TAB_1.EVOFC_P1 = EVOFC_P ;
  2418. TAB_1.EVOFC_M1 = EVOFC_JB ;
  2419. TAB_1.EVOFB_T2 = EVOFB_T1 ;
  2420. TAB_1.EVOFB_J1 = EVOFB_JL ;
  2421. FINSI ;
  2422. FINSI ;
  2423. SI ( TAB_1 . PFIXTONB ) ;
  2424. DESSIN TAB_1.EV_TETA XBOR T_LOC1 400. YBOR 0. 150000. MIMA ;
  2425. FINSI ;
  2426. DESSIN ( EVOFC ET TAB_1.EVOFE1 ET EVOFT ) XBOR 0. 400. YBOR 0. 7.E7 MIMA LEGE TAC2 ;
  2427. DESSIN TAB_1.ECONVEC1 XBOR 0. 400. YBOR 0. 700000. MIMA ;
  2428. FINSI ;
  2429. TAB_1.EVOFC1 = EVOFC ;
  2430. TAB_1.EVOFT1 = EVOFT ;
  2431. *
  2432. SI (NIVEAU >EG 4) ;
  2433. MESS '-----------------------------------> exit from @CALHCON ';
  2434. FINSI ;
  2435.  
  2436. FINPROC ;
  2437. **** @CALHRAY
  2438. DEBPROC @CALHRAY TAB1*TABLE ;
  2439. MESS ' ';
  2440. *
  2441. * !!! R. MITTEAU !!! attention, procedure standard
  2442. *
  2443. * un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
  2444. * pour les mises a jour
  2445. *
  2446. *-------------------------------------------------------------------*
  2447. * *
  2448. * COEFFICIENT D ECHANGE TENANT COMPTE *
  2449. * DU RAYONNEMENT *
  2450. * *
  2451. *-------------------------------------------------------------------*
  2452. *23456789012345678901234567890123456789012345678901234567890123456789012
  2453. * 1 2 3 4 5 6 7
  2454. *
  2455. * --- entrees
  2456. *
  2457. TZERO = TAB1.'TEMP_RAYO' ;
  2458. EPS1 = TAB1.'EMISSIVITE' ;
  2459. AB_2 = TAB1.'ABSORPTION' ;
  2460. NIVEAU1 = TAB1.'NIVEAU' ;
  2461. LTRAC = TAB1.'TRAC_GRAPHE' ;
  2462.  
  2463. SI (NIVEAU1 >EG 4 ) ;
  2464. MESS '-----------------------------------> calling @CALHRAY ';
  2465. FINSI ;
  2466.  
  2467. 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 ;
  2468. SIGMA =5.67E-8 ;
  2469. TZK = 273.3 ;
  2470. MESS '>@CALHRAY> STEFAN CONSTANT : ' SIGMA ;
  2471. MESS '>@CALHRAY> TZERO DEG. C : ' TZERO ;
  2472. MESS '>@CALHRAY> EMISSIVITY : ' EPS1 ;
  2473. MESS '>@CALHRAY> ABSORPTION : ' AB_2 ;
  2474. TZERK = TZERO + TZK ;
  2475. * MESS ' TEMP H FR ' ;
  2476. LISTH = PROG ;
  2477. LISFE = PROG ;
  2478. IH1 = 0 ;
  2479. REPETER CAH1 ( DIME LTEMR ) ;
  2480. IH1 = IH1 + 1 ;
  2481. TEMP = EXTR LTEMR IH1 ;
  2482. TEMK = TEMP + TZK ;
  2483. EPSEQ = (( 1./EPS1 ) + (1./AB_2) - 1.) ** -1 ;
  2484. * FE = SIGMA * ((EPS1 * ( TEMK ** 4 )) - (AB_2 * ( TZERK ** 4 )));
  2485. FE = SIGMA * EPSEQ *( ( TEMK ** 4 ) - ( TZERK ** 4 ) ) ;
  2486. * H1 = TEMK ** 3 ;
  2487. * H2 = ( TEMK ** 2 ) * ( TZERK ) ;
  2488. * H3 = ( TEMK ) * ( TZERK ** 2 ) ;
  2489. * H4 = TZERK ** 3 ;
  2490. * H = SIGMA * EPS1 * ( H1 + H2 + H3 + H4 ) ;
  2491. SI ( EGA TEMK TZERK 1. ) ;
  2492. H = FE / 1. ;
  2493. SINON ;
  2494. H = FE / ( TEMK - TZERK ) ;
  2495. FINSI ;
  2496. LISTH = LISTH ET ( PROG H ) ;
  2497. LISFE = LISFE ET ( PROG FE ) ;
  2498. * MESS TEMP H FE ;
  2499. FIN CAH1 ;
  2500. TITRE '>@CALHRAY> COEFFICIENT ECHANGE DE RAYONNEMENT ' ;
  2501. ERAYON = EVOL MANU 'TEMPERATURE' LTEMR 'COEFFICIENT ECHANGE' LISTH ;
  2502. TITRE '>@CALHRAY> FLUX DE CHALEUR RAYONNEE ' ;
  2503. EVOFE = EVOL MANU 'TEMPERATURE' LTEMR 'RAYONNEMENT' LISFE ;
  2504. TAB1.EVORAYT1 = EVOFE ;
  2505. TAB1.EHRAYON1 = ERAYON ;
  2506. *
  2507. SI LTRAC ;
  2508. DESSIN EVOFE XBOR 0. 3900. YBOR 0. 4.E6 ;
  2509. DESSIN ERAYON XBOR 0. 3900. YBOR 0. 1500. ;
  2510. FINSI;
  2511. *
  2512. SI (NIVEAU1 >EG 4 ) ;
  2513. MESS '-----------------------------------> exiting @CALHRAY ';
  2514. FINSI ;
  2515. FINPROC ERAYON ;
  2516. **** @CALOR
  2517. 'DEBPROC' @CALOR TAB1*'TABLE ' PUI1*FLOTTANT ;
  2518. MESS ' ' ;
  2519. * pour le calcul de la puissance voir CFLUX
  2520. *
  2521. VIN = TAB1 . V_IN ;
  2522. TIN = TAB1 . T_IN ;
  2523. CPF = @IPOE TIN TAB1.ETCPF ;
  2524. SI ( NON ( EXISTE TAB1 V_EMDOTI)) ;
  2525. RHOIN = @IPOE TIN TAB1.ETRHOF ;
  2526. NNUIN = @IPOE TIN TAB1.ETNNU ;
  2527. GIN = RHOIN * VIN ;
  2528. SI ( EXISTE TAB1 RIP_FLOWS ) ;
  2529. EMDOTI = GIN * ( TAB1 . RIP_FLOWS ) ;
  2530. SINON ;
  2531. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  2532. TAB1.HYP_SM = ( TAB1.LARG_CANAL * TAB1.HMIN_CANAL ) + ( 2. * ( TAB1.LARG_ESP * TAB1.HFIN ) ) ;
  2533. EMDOTI = GIN * TAB1.HYP_SM ;
  2534. SINON ;
  2535. PI = 3.14159 ;
  2536. DIAM1 = TAB1 . D_MAQUETTE ;
  2537. TTAPE = TAB1 . T_TAPE ;
  2538. EMDOTI = GIN * ( ( PI * DIAM1 * DIAM1 / 4. ) - ( DIAM1 * TTAPE) ) ;
  2539. FINSI ;
  2540. FINSI ;
  2541. TAB1.V_EMDOTI = EMDOTI ;
  2542. SINON ;
  2543. EMDOTI = TAB1.V_EMDOTI ;
  2544. FINSI ;
  2545. *
  2546. * Modif jb 01/04/95
  2547. * Possibilite de creer une procedure calculant
  2548. * la section de passage
  2549. *SI ( NON ( EXISTE TAB1 SP ) ) ;
  2550. * SI ( EXISTE TAB1 RIP_FLOWS ) ;
  2551. * TAB1.SP = TAB1.RIP_FLOWS ;
  2552. * FINSI ;
  2553. * SI ( EGA TAB1.HYPERVAP VRAI ) ;
  2554. * TAB1.HYP_SM = ( TAB1.LARG_CANAL * TAB1.HMIN_CANAL ) +
  2555. * ( 2. * ( TAB1.LARG_ESP * TAB1.HFIN ) ) ;
  2556. * TAB1.SP = TAB1.HYP_SM ;
  2557. * SINON ;
  2558. * PI = 3.14159 ;
  2559. * DIAM1 = TAB1 . D_MAQUETTE ;
  2560. * TTAPE = TAB1 . T_TAPE ;
  2561. * TAB1.SP = ( PI * DIAM1 * DIAM1 / 4. ) - ( DIAM1 * TTAPE) ;
  2562. * FINSI ;
  2563. *EMDOTI = GIN * TAB1.SP ;
  2564. *
  2565. DELT = PUI1 / (EMDOTI * CPF) ;
  2566. TOUT = TIN + DELT ;
  2567. TAB1.TEMPE_OUT = TOUT ;
  2568. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  2569. TAB1.'T_LOCAL' = TIN ;
  2570. TAB1.'T_MOY' = TIN ;
  2571. SINON ;
  2572. TAB1.'T_LOCAL' = TIN + ((TOUT - TIN) * TAB1.X_LOCAL) ;
  2573. TAB1.'T_MOY' = (TIN + TOUT) / 2. ;
  2574. FINSI ;
  2575. MESS '>@CALOR> TIN :' TIN ;
  2576. MESS '>@CALOR> TOUT DT :' TOUT DELT ;
  2577. MESS '>@CALOR> TMOY :' TAB1.'T_MOY' ;
  2578. MESS '>@CALOR> T_LOCAL :' TAB1.'T_LOCAL' ;
  2579. FINPROC ;
  2580. **** @CAPKPC
  2581. DEBPROC @CAPKPC EV_1*EVOLUTION PC_1*FLOTTANT D_1*FLOTTANT FL_INC*FLOTTANT NIV1/ENTIER;
  2582. *
  2583. * !!! R. MITTEAU !!! attention, procedure standard
  2584. *
  2585. * un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
  2586. * pour les mises a jour
  2587. *
  2588. * calcul du peaking factor correspondant au pourcentage PC_1
  2589. * FL_INC flux incident moyen
  2590. * EV_1 evolution donnant le flux en paroi d eau
  2591. SI (NON (EXISTE NIV1));
  2592. MESS '---------------------------------> calling @CAPKPC';
  2593. SINON;
  2594. SI (NIV1 >EG 4);
  2595. MESS '---------------------------------> calling @CAPKPC';
  2596. FINSI;
  2597. FINSI;
  2598. P_X_1 = EXTR EV_1 'ABSC' 1 ;
  2599. P_Y_1 = EXTR EV_1 'ORDO' 1 ;
  2600. N1 = DIME P_X_1 ;
  2601. VINT0 = MAXI (INTG ( EVOL MANU P_X_1 P_Y_1 )) ;
  2602. SI ( PC_1 >EG 1. ) ;
  2603. MESS ' >>>>> CAPKPC POURCENTAGE SUPERIEUR A 1 ' ;
  2604. ERRE ' >>>>> CAPKPC POURCENTAGE SUPERIEUR A 1 ' ;
  2605. FINSI ;
  2606. VA_1 = PC_1 * VINT0 ;
  2607. VINT1 = VINT0 ;
  2608. REPETER B__1 N1 ;
  2609. I_1 = DIME P_X_1 ;
  2610. P_X_2 = ENLE P_X_1 I_1 ;
  2611. P_Y_2 = ENLE P_Y_1 I_1 ;
  2612. VINT2 = MAXI (INTG ( EVOL MANU P_X_2 P_Y_2 )) ;
  2613. SI( VINT2 &lt;EG VA_1 ) ;
  2614. X_1 = EXTR P_X_1 I_1 ;
  2615. X_2 = EXTR P_X_1 (I_1 - 1) ;
  2616. Y_1 = EXTR P_Y_1 I_1 ;
  2617. Y_2 = EXTR P_Y_1 (I_1 - 1) ;
  2618. PENTE = (Y_1 - Y_2) / (X_1 - X_2) ;
  2619. DELTA = Y_2 ** 2 + ( 2. * PENTE *( VA_1 - VINT2 )) ;
  2620. SI ( DELTA < 0. ) ;
  2621. MESS ' >>>>> CAPKPC y a un truc DELTA < 0. ' ;
  2622. MESS ' >>>>> CAPKPC VINT2 VINT1 VA_1 ' VINT2 VINT1 VA_1 ;
  2623. MESS ' >>>>> CAPKPC Y_2 X_2 Y_1 X_1 ' Y_2 X_2 Y_1 X_1 ;
  2624. FINSI ;
  2625. * X_11 = X_2 + ((X_1 - X_2) / ( VINT1 - VINT2 )
  2626. * * ( VA_1 - VINT2 )) ;
  2627. RDELT = DELTA ** 0.5 ;
  2628. DX_11 = ( (-1. * Y_2) + RDELT ) / PENTE ;
  2629. X_11 = X_2 + DX_11 ;
  2630. SI ( (DX_11 * ( X_11 - X_1)) > 0. ) ;
  2631. MESS ' >>>>> CAPKPC y a un truc X_11 X_1 X_2 ' X_11 X_1 X_2;
  2632. MESS ' >>>>> CAPKPC VINT2 VINT1 VA_1 ' VINT2 VINT1 VA_1 ;
  2633. MESS ' >>>>> CAPKPC Y_2 X_2 Y_1 X_1 ' Y_2 X_2 Y_1 X_1 ;
  2634. MESS ' >>>>> CAPKPC PENTE DELTA RDELT' PENTE DELTA RDELT ;
  2635. FINSI ;
  2636. QUITTER B__1 ;
  2637. FINSI ;
  2638. P_X_1 = P_X_2 ;
  2639. P_Y_1 = P_Y_2 ;
  2640. VINT1 = VINT2 ;
  2641. FIN B__1 ;
  2642. FL_PC = VINT0 / X_11 ;
  2643. AL_1 = 2.* X_11 / D_1 ;
  2644. PKF_1 = FL_PC / FL_INC ;
  2645.  
  2646. SI (NON (EXISTE NIV1));
  2647. MESS '---------------------------------> exiting @CAPKPC';
  2648. SINON;
  2649. SI (NIV1 >EG 4);
  2650. MESS '---------------------------------> exiting @CAPKPC';
  2651. FINSI;
  2652. FINSI;
  2653. FINPROC AL_1 PKF_1 ;
  2654. **** @CBGMV
  2655. DEBPROC @CBGMV BXG*CHPOINT BYG*CHPOINT BZG*CHPOINT TAB1*TABLE ;
  2656. *
  2657. ********************************************************************
  2658. * Procedure de changement de base. On passe de la base cartesienne *
  2659. * globale de la machine definie par l'axe du tore dirige suivant *
  2660. * Z et l'axe X situe dans le plan median entre deux bobines a la *
  2661. * base cartesienne du maillage. *
  2662. * Trois cas sont etudies : 3D, 2D en coupe Phi constant et 2D en *
  2663. * coupe Theta constant. Alain MOAL (Decembre 1995-Janvier 1996) *
  2664. ********************************************************************
  2665. *
  2666. *--------------- VARIABLES D'ENTREE :
  2667. SI ((VALEUR DIME) EGA 2) ;
  2668. IPLAN = TAB1.<PLAN ;
  2669. SI (EGA IPLAN 'PHICONS') ;
  2670. CT0 = TAB1.<CENTRE_TORE ;
  2671. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  2672. P1 = TAB1.<POINT_SUR_OBJET ;
  2673. FINSI ;
  2674. SI (EGA IPLAN 'THECONS') ;
  2675. THETA0 = TAB1.<THETA0 ;
  2676. CP = TAB1.CENTRE_PLASMA ;
  2677. RP = TAB1.<RP ;
  2678. HP = TAB1.<HP ;
  2679. FINSI ;
  2680. SINON ;
  2681. CT0 = TAB1.<CENTRE_TORE ;
  2682. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  2683. P1 = TAB1.<POINT_SUR_OBJET ;
  2684. FINSI ;
  2685. ANGPHI0 = TAB1.<ANG_PHI0 ;
  2686. *------------------------------------
  2687. *
  2688. DIM0 = VALEUR DIME ;
  2689. SI (DIM0 EGA 2) ;
  2690. FINSI ;
  2691. *
  2692. SI (((DIM0 EGA 2) ET (EGA IPLAN 'PHICONS')) OU (DIM0 EGA 3)) ;
  2693. X0 Y0 Z0 = COOR CT0 ;
  2694. X1 Y1 Z1 = COOR CT1 ;
  2695. XP1 YP1 ZP1 = COOR P1 ;
  2696. *
  2697. * ---- Calcul des coordonnees du point P0, projection du point P1 de
  2698. * ---- l'objet dans le plan orthogonal a l'axe du tore en CT0.
  2699. A = X1 - X0 ;
  2700. B = Y1 - Y0 ;
  2701. C = Z1 - Z0 ;
  2702. *
  2703. SI (A EGA 0.) ;
  2704. SI (B EGA 0.) ;
  2705. XP0 = XP1 ;
  2706. YP0 = YP1 ;
  2707. ZP0 = Z0 ;
  2708. FINSI ;
  2709. SI (C EGA 0.) ;
  2710. XP0 = XP1 ;
  2711. YP0 = Y0 ;
  2712. ZP0 = ZP1 ;
  2713. FINSI ;
  2714. SI ((B NEG 0.) ET (C NEG 0.)) ;
  2715. XP0 = XP1 ;
  2716. YP0 = (-1.*B*C*ZP1 + (C*C*YP1) + (B*B*Y0) + (B*C*Z0)) /(B*B + (C*C)) ;
  2717. ZP0 = (B*ZP1 - (C*YP1) + (C*(Y0+Z0)))/(B+C);
  2718. FINSI ;
  2719. SINON ;
  2720. AUX1 = A / (A*A + (B*B) + (C*C)) ;
  2721. AUX2 = (B*B + (C*C)) / A ;
  2722. XP0 = AUX1 * (A*X0 + (B*Y0) + (C*Z0) + (AUX2*XP1) - (B*YP1) - (C*ZP1)) ;
  2723. YP0 = B * (XP0 - XP1) / A + YP1 ;
  2724. ZP0 = C * (XP0 - XP1) / A + ZP1 ;
  2725. FINSI ;
  2726. *
  2727. P0 = XP0 YP0 ZP0 ;
  2728. *
  2729. * ---- Rotation de la ligne (CT0,P0) pour l'aligner sur l'axe X
  2730. * ---- du repere global
  2731. LIG0 = CT0 D 1 P0 ;
  2732. LIG1 = LIG0 TOUR (-1.*ANGPHI0) CT0 CT1 ;
  2733. *
  2734. * ---- Calcul des 3 vecteurs unitaires du repere global
  2735. P0X = LIG1 POIN FINAL ;
  2736. DIR1 = P0X MOIN CT0 ;
  2737. VEC1 = DIR1 / (NORM DIR1) ;
  2738. DIR3 = CT1 MOIN CT0 ;
  2739. VEC3 = DIR3 / (NORM DIR3) ;
  2740. VEC2 = VEC3 PVEC VEC1 ;
  2741. *
  2742. * ---- Changement de repere
  2743. A1 B1 C1 = COOR VEC1 ;
  2744. A2 B2 C2 = COOR VEC2 ;
  2745. A3 B3 C3 = COOR VEC3 ;
  2746. *
  2747. BXM = (A1 * BXG) + (A2 * BYG) + (A3 * BZG) ;
  2748. BYM = (B1 * BXG) + (B2 * BYG) + (B3 * BZG) ;
  2749. BZM = (C1 * BXG) + (C2 * BYG) + (C3 * BZG) ;
  2750. *
  2751. SINON ;
  2752. *
  2753. * ---- en 2D pour une section a Theta constant
  2754. XCP YCP ZCP = COOR CP ;
  2755. NORM_CP = (XCP*XCP + (YCP*YCP) + (ZCP*ZCP))**0.5 ;
  2756. ANG1 = ATG XCP YCP ;
  2757. *
  2758. * ---- Rotation de (90 + ANGPHI0) par rapport a l'axe Z
  2759. BX1 = -1. * BXG * (SIN ANGPHI0) + (BYG * (COS ANGPHI0)) ;
  2760. BY1 = -1. * BXG * (COS ANGPHI0) - (BYG * (SIN ANGPHI0)) ;
  2761. BZ1 = BZG ;
  2762. *
  2763. * ---- Rotation de -THETA0 par rapport a l'axe X
  2764. BX2 = BX1 ;
  2765. BY2 = BY1 * (COS THETA0) - (BZ1 * (SIN THETA0)) ;
  2766. BZ2 = BY1 * (SIN THETA0) + (BZ1 * (COS THETA0)) ;
  2767. *
  2768. * ---- Rotation de ANG1 par rapport a l'axe Z
  2769. BXM = BX2 * (COS ANG1) + (BY2 * (SIN ANG1)) ;
  2770. BYM = -1. * BX2 * (SIN ANG1) + (BY2 * (COS ANG1)) ;
  2771. BZM = BZ2 ;
  2772. *
  2773. FINSI ;
  2774.  
  2775. SI (DIM0 EGA 2) ;
  2776. FINSI ;
  2777. *
  2778. FINPROC BXM BYM BZM ;
  2779. **** @CBGTV
  2780. DEBPROC @CBGTV BX*CHPOINT BY*CHPOINT BZ*CHPOINT THETA*CHPOINT PHI*CHPOINT ;
  2781. *
  2782. **********************************************************************
  2783. * Procedure de changement de base pour un vecteur B de coordonnees *
  2784. * BX, BY, BZ dans la base globale aux coordonnees pseudo-toroidales *
  2785. * BRHO, BTHETA, BPHI. Alain MOAL (mars 1996) *
  2786. **********************************************************************
  2787. *
  2788. *---- Rotation de Phi autour de "l'axe Theta"
  2789. BRHO1 = (COS PHI) * BX + ((SIN PHI) * BY) ;
  2790. BTHETA1 = BZ ;
  2791. BPHI1 = -1.*(SIN PHI) * BX + ((COS PHI) * BY) ;
  2792. *
  2793. *---- Rotation de Theta autour de "l'axe Phi"
  2794. BRHO = (COS THETA) * BRHO1 + ((SIN THETA) * BTHETA1) ;
  2795. BTHETA = -1.*(SIN THETA) * BRHO1 + ((COS THETA) * BTHETA1) ;
  2796. BPHI = BPHI1 ;
  2797. *
  2798. FINPROC BRHO BTHETA BPHI ;
  2799. **** @CBLMV
  2800. DEBPROC @CBLMV VXL*CHPOINT VYL*CHPOINT VZL*CHPOINT TAB1*TABLE ;
  2801. *
  2802. ********************************************************************
  2803. * Version amelioree de l'ancien @CBLMV rebaptise @ACBLM *
  2804. * Procedure de changement de base. On passe de la base cartesienne *
  2805. * locale de l'objet modelise a la base cartesienne du maillage. *
  2806. * l'axe Y est dirige du point de tangence au plasma vers le centre *
  2807. * du plasma. En 3D, L'axe X du repere local est dans la direction *
  2808. * toroidale. *
  2809. * en 2D cas PHICONS l'axe Z du repere local est l'axe toroidal *
  2810. * en 2D cas THECONS l'axe x du repere local est l'axe toroidal *
  2811. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  2812. ********************************************************************
  2813. *
  2814. *--------------- VARIABLES D'ENTREE :
  2815. CP = TAB1.CENTRE_PLASMA ;
  2816. PTG = TAB1.PT_TGPLASMA ;
  2817. SI ((VALEUR DIME) EGA 2) ;
  2818. SI (EXISTE TAB1 <PLAN) ;
  2819. IPLAN = TAB1.<PLAN ;
  2820. SINON ;
  2821. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  2822. FINSI ;
  2823. SINON ;
  2824. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  2825. DIR1 = TAB1.<DIR_TOROIDAL ;
  2826. SINON ;
  2827. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  2828. FINSI ;
  2829. FINSI ;
  2830. *------------------------------------
  2831. *
  2832. SI ((VALEUR DIME) EGA 2) ;
  2833. VECT0 = CP MOINS PTG ;
  2834. VX VY = COOR VECT0 ;
  2835. *
  2836. * ---- calcul de l'angle de rotation dans le plan XY
  2837. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  2838. ANG1 = 0. ;
  2839. SINON ;
  2840. ANG1 = -1.* (ATG VX VY) ;
  2841. FINSI ;
  2842. *
  2843. SI (EGA IPLAN 'PHICONS');
  2844. * ---- Coupe 2D a Phi constant
  2845. VXL1 = VZL ;
  2846. VYL1 = VYL ;
  2847. VZL1 = VXL * (-1.);
  2848. * ---- rotation
  2849. VXM = VXL1 * (COS ANG1) + (VYL1 * (-1.) * (SIN ANG1));
  2850. VYM = VXL1 * (SIN ANG1) + (VYL1 * (COS ANG1)) ;
  2851. VZM = VZL1 ;
  2852. FINSI ;
  2853. SI (EGA IPLAN 'THECONS');
  2854. * ---- Coupe 2D a Theta constant
  2855. * ---- rotation
  2856. VXM = VXL * (COS ANG1) + (VYL * (-1.) * (SIN ANG1)) ;
  2857. VYM = VXL * (SIN ANG1) + (VYL * (COS ANG1)) ;
  2858. VZM = VZL ;
  2859. FINSI;
  2860. *
  2861. SINON ;
  2862. *
  2863. VEC1 = DIR1 / (NORM DIR1) ;
  2864. DIR2 = CP MOINS PTG ;
  2865. VEC2 = DIR2 / (NORM DIR2) ;
  2866. VEC3 = VEC1 PVEC VEC2 ;
  2867. *
  2868. A1 B1 C1 = COOR VEC1 ;
  2869. A2 B2 C2 = COOR VEC2 ;
  2870. A3 B3 C3 = COOR VEC3 ;
  2871. *
  2872. VXM = (A1 * VXL) + (A2 * VYL) + (A3 * VZL) ;
  2873. VYM = (B1 * VXL) + (B2 * VYL) + (B3 * VZL) ;
  2874. VZM = (C1 * VXL) + (C2 * VYL) + (C3 * VZL) ;
  2875. *
  2876. FINSI ;
  2877. FINPROC VXM VYM VZM ;
  2878.  
  2879. **** @CBMGV
  2880. DEBPROC @CBMGV BXM*CHPOINT BYM*CHPOINT BZM*CHPOINT TAB1*TABLE ;
  2881. *
  2882. ********************************************************************
  2883. * Procedure de changement de base. On passe de la base cartesienne *
  2884. * quelconque du maillage a la base cartesienne globale de la *
  2885. * machine definie par l'axe du tore dirige suivant Z et l'axe X *
  2886. * situe dans le plan median entre deux bobines. *
  2887. * Trois cas sont etudies : 3D, 2D en coupe Phi constant et 2D en *
  2888. * coupe Theta constant. Alain MOAL (Decembre 1995-Janvier 1996) *
  2889. ********************************************************************
  2890. *
  2891. *--------------- VARIABLES D'ENTREE :
  2892. SI ((VALEUR DIME) EGA 2) ;
  2893. IPLAN = TAB1.<PLAN ;
  2894. SI (EGA IPLAN 'PHICONS') ;
  2895. CT0 = TAB1.<CENTRE_TORE ;
  2896. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  2897. P1 = TAB1.<POINT_SUR_OBJET ;
  2898. FINSI ;
  2899. SI (EGA IPLAN 'THECONS') ;
  2900. THETA0 = TAB1.<THETA0 ;
  2901. CP = TAB1.CENTRE_PLASMA ;
  2902. RP = TAB1.<RP ;
  2903. HP = TAB1.<HP ;
  2904. FINSI ;
  2905. SINON ;
  2906. CT0 = TAB1.<CENTRE_TORE ;
  2907. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  2908. P1 = TAB1.<POINT_SUR_OBJET ;
  2909. FINSI ;
  2910. ANGPHI0 = TAB1.<ANG_PHI0 ;
  2911. *------------------------------------
  2912. *
  2913. DIM0 = VALEUR DIME ;
  2914. SI (DIM0 EGA 2) ;
  2915. FINSI ;
  2916. *
  2917. SI (((DIM0 EGA 2) ET (EGA IPLAN 'PHICONS')) OU (DIM0 EGA 3)) ;
  2918. * ---- en 3D ou en 2D pour la section Phi constant
  2919. X0 Y0 Z0 = COOR CT0 ;
  2920. X1 Y1 Z1 = COOR CT1 ;
  2921. XP1 YP1 ZP1 = COOR P1 ;
  2922. *
  2923. * ---- Calcul des coordonnees du point P0, projection du point P1 de
  2924. * ---- l'objet dans le plan orthogonal a l'axe du tore en CT0.
  2925. A = X1 - X0 ;
  2926. B = Y1 - Y0 ;
  2927. C = Z1 - Z0 ;
  2928. *
  2929. SI (A EGA 0.) ;
  2930. SI (B EGA 0.) ;
  2931. XP0 = XP1 ;
  2932. YP0 = YP1 ;
  2933. ZP0 = Z0 ;
  2934. FINSI ;
  2935. SI (C EGA 0.) ;
  2936. XP0 = XP1 ;
  2937. YP0 = Y0 ;
  2938. ZP0 = ZP1 ;
  2939. FINSI ;
  2940. SI ((B NEG 0.) ET (C NEG 0.)) ;
  2941. XP0 = XP1 ;
  2942. YP0 = (-1.*B*C*ZP1 + (C*C*YP1) + (B*B*Y0) + (B*C*Z0)) /(B*B + (C*C)) ;
  2943. ZP0 = (B*ZP1 - (C*YP1) + (C*(Y0+Z0)))/(B+C);
  2944. FINSI ;
  2945. SINON ;
  2946. AUX1 = A / (A*A + (B*B) + (C*C)) ;
  2947. AUX2 = (B*B + (C*C)) / A ;
  2948. XP0 = AUX1 * (A*X0 + (B*Y0) + (C*Z0) + (AUX2*XP1) - (B*YP1) - (C*ZP1)) ;
  2949. YP0 = B * (XP0 - XP1) / A + YP1 ;
  2950. ZP0 = C * (XP0 - XP1) / A + ZP1 ;
  2951. FINSI ;
  2952. *
  2953. P0 = XP0 YP0 ZP0 ;
  2954. *
  2955. * ---- Rotation de la ligne (CT0,P0) pour l'aligner sur l'axe X
  2956. * ---- du repere global
  2957. LIG0 = CT0 D 1 P0 ;
  2958. LIG1 = LIG0 TOUR (-1.*ANGPHI0) CT0 CT1 ;
  2959. *
  2960. * ---- Calcul des 3 vecteurs unitaires du repere global
  2961. P0X = LIG1 POIN FINAL ;
  2962. DIR1 = P0X MOIN CT0 ;
  2963. VEC1 = DIR1 / (NORM DIR1) ;
  2964. DIR3 = CT1 MOIN CT0 ;
  2965. VEC3 = DIR3 / (NORM DIR3) ;
  2966. VEC2 = VEC3 PVEC VEC1 ;
  2967. *
  2968. * ---- Changement de repere
  2969. A1 B1 C1 = COOR VEC1 ;
  2970. A2 B2 C2 = COOR VEC2 ;
  2971. A3 B3 C3 = COOR VEC3 ;
  2972. *
  2973. BXG = (A1 * BXM) + (B1 * BYM) + (C1 * BZM) ;
  2974. BYG = (A2 * BXM) + (B2 * BYM) + (C2 * BZM) ;
  2975. BZG = (A3 * BXM) + (B3 * BYM) + (C3 * BZM) ;
  2976. *
  2977. SINON ;
  2978. * ---- en 2D pour une section a Theta constant
  2979. *
  2980. XCP YCP ZCP = COOR CP ;
  2981. NORM_CP = (XCP*XCP + (YCP*YCP) + (ZCP*ZCP))**0.5 ;
  2982. ANG1 = ATG XCP YCP ;
  2983. *
  2984. * ---- Rotation de - ANG1 par rapport a l'axe Z
  2985. BX1 = BXM * (COS ANG1) - (BYM * (SIN ANG1)) ;
  2986. BY1 = BXM * (SIN ANG1) + (BYM * (COS ANG1)) ;
  2987. BZ1 = BZM ;
  2988. *
  2989. * ---- Rotation de THETA0 par rapport a l'axe X
  2990. BX2 = BX1 ;
  2991. BY2 = BY1 * (COS THETA0) + (BZ1 * (SIN THETA0)) ;
  2992. BZ2 = -1. * BY1 * (SIN THETA0) + (BZ1 * (COS THETA0)) ;
  2993. *
  2994. * ---- Rotation de -(90 + ANGPHI0) par rapport a l'axe Z
  2995. BXG = -1. * BX2 * (SIN ANGPHI0) - (BY2 * (COS ANGPHI0)) ;
  2996. BYG = BX2 * (COS ANGPHI0) - (BY2 * (SIN ANGPHI0)) ;
  2997. BZG = BZ2 ;
  2998. *
  2999. FINSI;
  3000. *
  3001. SI (DIM0 EGA 2) ;
  3002. FINSI ;
  3003. *
  3004. FINPROC BXG BYG BZG ;
  3005.  
  3006. **** @CBMLV
  3007. DEBPROC @CBMLV VXM*CHPOINT VYM*CHPOINT VZM*CHPOINT TAB1*TABLE ;
  3008. *
  3009. ********************************************************************
  3010. * Version amelioree de l'ancien @CBMLV rebaptise @ACBML *
  3011. * Procedure de changement de base. On passe de la base cartesienne *
  3012. * du maillage a la base cartesienne locale de l'objet modelise. *
  3013. * l'axe Y final est dirige du point de tangence vers le centre du *
  3014. * plasma. En 3D l'axe x du repere local est donne par la direction *
  3015. * toroidale *
  3016. * en 2D cas PHICONS l'axe Z initial est l'axe toroidal *
  3017. * en 2D cas THECONS l'axe x initial est l'axe toroidal *
  3018. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  3019. ********************************************************************
  3020. *
  3021. *--------------- VARIABLES D'ENTREE :
  3022. CP = TAB1.CENTRE_PLASMA ;
  3023. PTG = TAB1.PT_TGPLASMA ;
  3024. SI ((VALEUR DIME) EGA 2) ;
  3025. SI (EXISTE TAB1 <PLAN) ;
  3026. IPLAN = TAB1.<PLAN ;
  3027. SINON ;
  3028. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  3029. FINSI ;
  3030. SINON ;
  3031. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  3032. DIR1 = TAB1.<DIR_TOROIDAL ;
  3033. SINON ;
  3034. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  3035. FINSI ;
  3036. FINSI ;
  3037. *------------------------------------
  3038. *
  3039. SI ((VALEUR DIME) EGA 2) ;
  3040. VECT0 = CP MOINS PTG ;
  3041. VX VY = COOR VECT0 ;
  3042. *
  3043. * ---- calcul de l'angle de rotation dans le plan XY
  3044. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  3045. ANG1 = 0. ;
  3046. SINON ;
  3047. ANG1 = -1.* (ATG VX VY) ;
  3048. FINSI ;
  3049. *
  3050. * ---- rotation pour aligner l'axe Y avec VECT0
  3051. SI (EGA IPLAN 'PHICONS');
  3052. * ---- Coupe 2D a Phi constant
  3053. VXL1 = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  3054. VYL1 = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  3055. VZL1 = VZM ;
  3056. * ---- Coupe 2D a Phi constant
  3057. VXL = VZL1 ;
  3058. VYL = VYL1 ;
  3059. VZL = VXL1 * (-1.);
  3060. FINSI ;
  3061. SI (EGA IPLAN 'THECONS');
  3062. * ---- Coupe 2D a Theta constant
  3063. * ---- rotation
  3064. VXL = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  3065. VYL = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  3066. VZL = VZM ;
  3067. FINSI ;
  3068. *
  3069. SINON ;
  3070. *
  3071. VEC1 = DIR1 / (NORM DIR1) ;
  3072. DIR2 = CP MOINS PTG ;
  3073. VEC2 = DIR2 / (NORM DIR2) ;
  3074. VEC3 = VEC1 PVEC VEC2 ;
  3075. *
  3076. A1 B1 C1 = COOR VEC1 ;
  3077. A2 B2 C2 = COOR VEC2 ;
  3078. A3 B3 C3 = COOR VEC3 ;
  3079. *
  3080. VXL = (A1 * VXM) + (B1 * VYM) + (C1 * VZM) ;
  3081. VYL = (A2 * VXM) + (B2 * VYM) + (C2 * VZM) ;
  3082. VZL = (A3 * VXM) + (B3 * VYM) + (C3 * VZM) ;
  3083. *
  3084. FINSI ;
  3085. FINPROC VXL VYL VZL ;
  3086. **** @CBTGV
  3087. DEBPROC @CBTGV BRHO*CHPOINT BTHETA*CHPOINT BPHI*CHPOINT THETA*CHPOINT PHI*CHPOINT ;
  3088. *
  3089. *********************************************************************
  3090. * Procedure de changement de base pour un vecteur B de coordonnees *
  3091. * BRHO, BPHI, BTHETA dans une base pseudo-toroidale aux coordonnees *
  3092. * cartesiennes BX, BY, BZ dans la base globale de la machine. *
  3093. * Alain MOAL (decembre 1995) *
  3094. *********************************************************************
  3095. *
  3096. *---- Rotation de - Theta autour de "l'axe Phi"
  3097. BRHO1 = (COS THETA) * BRHO - ((SIN THETA) * BTHETA) ;
  3098. BTHETA1 = (SIN THETA) * BRHO + ((COS THETA) * BTHETA) ;
  3099. BPHI1 = BPHI ;
  3100. *
  3101. *---- Rotation de - Phi autour de "l'axe Theta"
  3102. BRHO2 = (COS PHI) * BRHO1 - ((SIN PHI) * BPHI1) ;
  3103. BTHETA2 = BTHETA1 ;
  3104. BPHI2 = (SIN PHI) * BRHO1 + ((COS PHI) * BPHI1) ;
  3105. *
  3106. BX = BRHO2 ;
  3107. BY = BPHI2 ;
  3108. BZ = BTHETA2 ;
  3109. *
  3110. FINPROC BX BY BZ ;
  3111. **** @CBTLV
  3112. DEBPROC @CBTLV BRHO*CHPOINT BTHETA*CHPOINT BPHI*CHPOINT THETA*CHPOINT PHI*CHPOINT TAB1*TABLE ;
  3113. *
  3114. *********************************************************************
  3115. * Procedure de changement de base pour un vecteur B de coordonnees *
  3116. * BRHO, BPHI, BTHETA dans une base pseudo-toroidale aux coordonnees *
  3117. * cartesiennes BX, BY, BZ dans la base de l'objet. *
  3118. * Alain MOAL (juin 1995) *
  3119. *********************************************************************
  3120. *
  3121. *--------------- VARIABLES D'ENTREE :
  3122. THETA0 = TAB1.<THETA0 ;
  3123. *------------------------------------
  3124. *
  3125. CT = COS THETA ;
  3126. ST = SIN THETA ;
  3127. CT0 = COS THETA0 ;
  3128. ST0 = SIN THETA0 ;
  3129. MST0 = ST0 * -1. ;
  3130. CPHI = COS PHI ;
  3131. SPHI = SIN PHI ;
  3132. MSPHI= SPHI * -1. ;
  3133. *
  3134. *---- 1) rotation de - Theta autour de "l'axe Phi"
  3135. BRHO1 = (CT * BRHO) - (ST * BTHETA) ;
  3136. BTHETA1 = (ST * BRHO) + (CT * BTHETA) ;
  3137. BPHI1 = BPHI ;
  3138. *
  3139. *---- 2) rotation de - Phi autour de "l'axe Theta"
  3140. BRHO2 = (CPHI * BRHO1) + (MSPHI * BPHI1) ;
  3141. BTHETA2 = BTHETA1 ;
  3142. BPHI2 = (SPHI * BRHO1) + (CPHI * BPHI1) ;
  3143. *
  3144. *---- 3) rotation de Theta0 autour de "l'axe Phi"
  3145. BRHO3 = (BRHO2 * CT0) + (BTHETA2 * ST0) ;
  3146. BTHETA3 = (BRHO2 * MST0) + (BTHETA2 * CT0) ;
  3147. BPHI3 = BPHI2 ;
  3148. *
  3149. *---- 4) composantes dans le repere cartesien
  3150. BX = BPHI3 ;
  3151. BY = BRHO3 * -1. ;
  3152. BZ = BTHETA3 ;
  3153. *
  3154. FINPROC BX BY BZ;
  3155. **** PROP_PHY
  3156. DEBPROC PROP_PHY TAB_1*TABLE ;
  3157. ******************************************************************************
  3158. ***** CELATA94 *****
  3159. ******************************************************************************
  3160. * CALCUL DU FLUX CRITIQUE SUIVANT LA CORRELATION DE CELATA 94
  3161. *_____________________________________________________________________________
  3162. *
  3163. *
  3164. *
  3165. *-----------------------------------------------------
  3166. * Calcul des proprietes de l eau a la temperature de
  3167. * saturation correspondant a la pression de sortie
  3168. *-----------------------------------------------------
  3169. *
  3170. @TABEAU TAB_1 ;
  3171. POUT = TAB_1.'P_LOCAL' ;
  3172. TAB_1.TTSAT = @IPOE POUT TAB_1.EPTSAT ;
  3173. TSAT = TAB_1.TTSAT ;
  3174. TAB_1.CCPLOUT = @IPOE TSAT TAB_1.ETCPF ;
  3175. TAB_1.RRHOL = @IPOE TSAT TAB_1.ETRHOF ;
  3176. TAB_1.RRHOV = @IPOE TSAT TAB_1.ETRHOG ;
  3177. TAB_1.LLLV = @IPOE TSAT TAB_1.ETHFG ;
  3178. TAB_1.LLAM = @IPOE TSAT TAB_1.ETLLA ;
  3179. TAB_1.SSIGM = @IPOE TSAT TAB_1.ETSIGM ;
  3180. TAB_1.MMUL = @IPOE TSAT TAB_1.ETNNU ;
  3181. TAB_1.PPRAL = @IPOE TSAT TAB_1.ETPRAF ;
  3182. *
  3183. *-----------------------------------------------------
  3184. * Calcul des proprietes de l eau a la temperature d entree
  3185. *-----------------------------------------------------
  3186. *
  3187. TIN = TAB_1.'T_LOCAL' ;
  3188. TAB_1.CCPLIN = @IPOE TIN TAB_1.ETCPF ;
  3189. TAB_1.RRHOLIN = @IPOE TIN TAB_1.ETRHOF ;
  3190. *
  3191. *-----------------------------------------------------
  3192. * Calcul de quantites utiles
  3193. *-----------------------------------------------------
  3194. *
  3195. PI = 3.1415926 ;
  3196. D = TAB_1.D_MAQUETTE ;
  3197. SI ( NON ( EXISTE TAB_1 T_TAPE ) ) ;
  3198. TAB_1 . T_TAPE = 0. ;
  3199. FINSI ;
  3200. TTAPE = TAB_1 . T_TAPE ;
  3201. SI ( NON ( EXISTE TAB_1 TWIST_RATIO ) ) ;
  3202. TAB_1 . TWIST_RATIO = 0. ;
  3203. FINSI ;
  3204. YTWIST = TAB_1 . TWIST_RATIO ;
  3205. VIN = TAB_1.'V_LOCAL' ;
  3206. *
  3207. *-----------------------------------------------------
  3208. * Prise en compte de l insert torsade
  3209. *-----------------------------------------------------
  3210. *
  3211. SI ( YTWIST EGA 0. ) ;
  3212. TAB_1 . DDH = D ;
  3213. FACV = 1. ;
  3214. VP = VIN ;
  3215. FINSI ;
  3216. SI ( YTWIST > 0. ) ;
  3217. QUAS = 4. * (( PI * D * D / 8. ) - ( TTAPE * D / 2. )) ;
  3218. PERI = (( PI * D / 2. ) - TTAPE + D ) ;
  3219. DH = QUAS / PERI ;
  3220. TAB_1 . DDH = DH ;
  3221. PIS2Y = PI / ( 2. * YTWIST ) ;
  3222. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** ( 1. / 2. ) ;
  3223. FINSI ;
  3224. *-----------------------------------------------------
  3225. * Prise en compte du fil helicoidal
  3226. *-----------------------------------------------------
  3227. *
  3228. SI ( NON ( EXISTE TAB_1 HELI_WIRE ) ) ;
  3229. TAB_1.HELI_WIRE = FAUX ;
  3230. FINSI ;
  3231. SI ( ( YTWIST EGA 0. ) ET ( EGA TAB_1.HELI_WIRE VRAI ) ) ;
  3232. S1 = PI * D1 * D1 / 4. ;
  3233. SM = PI * TAB_1.WIRE_D * TAB_1.WIRE_D / 4. ;
  3234. P1 = PI * D ;
  3235. PM = PI * TAB_1.WIRE_D ;
  3236. DH = 4. * ( S1 - SM ) / ( P1 + PM ) ;
  3237. PIS2Y = PI / ( 2 * TAB_1.PITCH_WIRE ) ;
  3238. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  3239. * FACV = 1. ;
  3240. FINSI ;
  3241. *
  3242. *-----------------------------------------------------
  3243. * Calcul de la vitesse
  3244. *-----------------------------------------------------
  3245. *
  3246. SI (NON (EXISTE TAB_1 FF_SANDIA)) ;
  3247. TAB_1 . FF_SANDIA = FAUX ;
  3248. FINSI ;
  3249. F_SANDIA = TAB_1 . FF_SANDIA ;
  3250. SI ( F_SANDIA EGA VRAI ) ;
  3251. FACV = 1. ;
  3252. FINSI ;
  3253. VP = VIN * FACV ;
  3254. TAB_1 . VITPAROI = VP ;
  3255. *
  3256. *-----------------------------------------------------
  3257. * Prise en compte du chauffage non asymetrique
  3258. *-----------------------------------------------------
  3259. *
  3260. LH = TAB_1 . L_HEATED ;
  3261. SI ( NON ( EXISTE TAB_1 CCHAU_SYM ) ) ;
  3262. TAB_1 . CCHAU_SYM = VRAI ;
  3263. FINSI ;
  3264. SI ( TAB_1 . CCHAU_SYM EGA VRAI ) ;
  3265. TAB_1.HHAR = PI * D * LH ;
  3266. AR = PI * D * D / 4. ;
  3267. SINON ;
  3268. QUAS = 4. * (( PI * D * D / 8. ) - ( TTAPE * D / 2. )) ;
  3269. AR = QUAS / 4. ;
  3270. ** PERI = (( PI * D / 2. ) - TTAPE ) ;
  3271. ** DHC = QUAS / PERI ;
  3272. ** TAB_1.HHAR = PI * ( D / 2. ) * LH ;
  3273. TAB_1.HHAR = D * LH ;
  3274. FINSI ;
  3275. *
  3276. MUL = TAB_1.MMUL ;
  3277. RHOLIN = TAB_1.RRHOLIN ;
  3278. G = RHOLIN * VP ;
  3279. TAB_1.GGAM = RHOLIN * VP * AR ;
  3280. TAB_1.GG = G ;
  3281. REYL = G * TAB_1 . DDH / MUL ;
  3282. *
  3283. *-----------------------------------------------------
  3284. * Calcul du coefficient de frottement
  3285. *-----------------------------------------------------
  3286. *
  3287. * Facteur de Sandia
  3288. * multiplier le coefficient de frottement par
  3289. * 2.75 * ( YTWIST ** ( - 0.406 ) )
  3290. * 2.2 * ( YTWIST ** ( - 0.406 ) )
  3291. FA = 4. * 1.375E-3 * (( 1. + ( 21.544 * ( 0.00375 /( TAB_1 . DDH * 1000. / 2. ))) + ( 100. / REYL )) ** ( 1. / 3. )) ;
  3292. SI ( ( F_SANDIA EGA VRAI ) ET ( YTWIST NEG 0. ) ) ;
  3293. * FA = FA * (2.75 / ( YTWIST ** ( 0.406 ) )) ;
  3294. FA = FA * (2.2 / ( YTWIST ** ( 0.406 ) )) ;
  3295. FINSI ;
  3296. SIGM = TAB_1.SSIGM ;
  3297. RHOL = TAB_1.RRHOL ;
  3298. REPETER BOUCFA 100 ;
  3299. RADEFF = 1.14 - ( 2. * ( LOG ((( 0.72 * SIGM * RHOL ) / ( FA * TAB_1 . DDH * ( G**2 ))) + ( 9.35 / ( REYL *( FA **( 1. / 2. ))))))/( LOG 10 )) ;
  3300. DIF1 = ( RADEFF ** (-2))- FA ;
  3301. DELTAF = ABS (DIF1) ;
  3302. FA = RADEFF**(-2) ;
  3303. SI ( ( F_SANDIA EGA VRAI ) ET ( YTWIST NEG 0. ) ) ;
  3304. * FA = FA * (2.75 * ( YTWIST ** ( -0.406 ) )) ;
  3305. FA = FA * (2.2 * ( YTWIST ** ( -0.406 ) )) ;
  3306. TAB_1.FFA = FA ;
  3307. SINON ;
  3308. TAB_1.FFA = FA ;
  3309. FINSI ;
  3310. SI (DELTAF &lt;EG 1.E-6) ;
  3311. QUITTER BOUCFA ;
  3312. FINSI ;
  3313. FIN BOUCFA ;
  3314. FINPROC ;
  3315. *
  3316. *_____________________________________________________________________________
  3317. *
  3318. **** QCALCO
  3319. DEBPROC QCALCO TAB_1*TABLE Q*FLOTTANT ;
  3320. *
  3321. TIN = TAB_1.T_IN ;
  3322. TSAT = TAB_1.TTSAT ;
  3323. GAM = TAB_1.GGAM ;
  3324. G = TAB_1.GG ;
  3325. HAR = TAB_1.HHAR ;
  3326. *
  3327. *-----------------------------------------------------
  3328. * Calcul de la temperature moyenne du fluide
  3329. *-----------------------------------------------------
  3330. *
  3331. CPLIN = TAB_1.CCPLIN ;
  3332. CPLOUT = TAB_1.CCPLOUT ;
  3333. CPLMED = ( CPLIN + CPLOUT )/ 2. ;
  3334. *MESS ' CPLIN = ' CPLIN ;
  3335. *MESS ' CPLOUT = ' CPLOUT ;
  3336. *MESS ' CPLMED = ' CPLMED ;
  3337. *MESS ' HAR = ' HAR ;
  3338. *MESS ' GAM = ' GAM ;
  3339. *MESS ' Q = ' Q ;
  3340. *TMED = TIN + (( Q * HAR )/( GAM * CPLMED )) ;
  3341. TMED = TIN + (( Q * HAR )/( GAM * CPLIN )) ;
  3342. * MESS 'MEAN FLUID TEMPERATURE (C) :' TMED ;
  3343. *
  3344. *-----------------------------------------------------
  3345. * Calcul de la temperature de la paroi
  3346. *-----------------------------------------------------
  3347. *
  3348. FA = TAB_1.FFA ;
  3349. RHOL = TAB_1.RRHOL ;
  3350. PRAL = TAB_1.PPRAL ;
  3351. MUL = TAB_1.MMUL ;
  3352. D = TAB_1.D_MAQUETTE ;
  3353. *MESS ' FA =' FA ;
  3354. *MESS ' RHOL = ' RHOL ;
  3355. *MESS ' PRAL = ' PRAL ;
  3356. *MESS ' MUL = ' MUL ;
  3357. *MESS ' D = ' D ;
  3358. UTAU = ( FA * ( G **2 ))/(8.*( RHOL**2 ))**(1./2.) ;
  3359. *MESS ' UTAU =' UTAU ;
  3360. QU = Q /(RHOL * CPLOUT * UTAU) ;
  3361. *MESS ' QU = ' QU ;
  3362. R = D / 2. ;
  3363. TT = 1. + (5.* PRAL ) ;
  3364. *MESS ' TT = ' TT ;
  3365. XX = ( R * UTAU * RHOL )/ MUL ;
  3366. *MESS ' XX = ' XX ;
  3367. ZZ = XX - 30. ;
  3368. 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 ))) ));
  3369. MESS '>QCALCO> WALL TEMPERATURE (C) : ' TW ;
  3370. * MESS ' SATURATION TEMPERATURE (C) : ' TSAT ;
  3371. SI ( TW &lt;EG TSAT ) ;
  3372. IFLAG = 1 ;
  3373. QUITTER QCALCO ;
  3374. MESS '----->>>>>>>>' ;
  3375. FINSI ;
  3376. *
  3377. *-----------------------------------------------------
  3378. * Calcul de l epaisseur de la couche liquide surchauffee
  3379. *-----------------------------------------------------
  3380. *
  3381. *MESS '-----------------------------------> TW>TSAT ' ;
  3382. DT1 = QU * PRAL * 5. ;
  3383. DT2 = 5.* QU * ( PRAL + ( LOG ( 1. + ( 5. * PRAL )))) ;
  3384. SI (( TW - TSAT ) < DT1 ) ;
  3385. YPIU = ( TW - TSAT )/( QU * PRAL ) ;
  3386. SINON ;
  3387. SI (( TW - TSAT ) < DT2 ) ;
  3388. YPIU = 5. + ( ( 5. / PRAL )* ( EXP (( TW - TSAT )/( 5. * QU )- PRAL )- 1. )) ;
  3389. SINON ;
  3390. AA1 = ( TW - TSAT )/( 5. * QU ) ;
  3391. AA2 = 1. + ( 5. * PRAL ) ;
  3392. AA = ( AA1 - PRAL - ( LOG AA2 )) * 2. ;
  3393. YPIU = 30.* (EXP AA) ;
  3394. FINSI ;
  3395. FINSI ;
  3396. YSTAR = ( YPIU * MUL )/( UTAU * RHOL ) ;
  3397. * MESS ' SUPERHEATED LAYER THICKNESS (m) : ' YSTAR ;
  3398. *
  3399. *-----------------------------------------------------
  3400. * Calcul de l epaisseur de l amas de vapeur et de
  3401. * sa distance de la paroi chauffee
  3402. *-----------------------------------------------------
  3403. *
  3404. SIGM = TAB_1.SSIGM ;
  3405. DB = ( 32. / FA ) * ( SIGM * 0.03 * RHOL /( G**2 )) ;
  3406. DELTA = YSTAR - DB ;
  3407. * MESS ' INITIAL LIQUID SUBLAYER THICKNESS (m) : ' DELTA ;
  3408. SI (DELTA &lt;EG 0.) ;
  3409. IFLAG = 1 ;
  3410. QUITTER QCALCO ;
  3411. FINSI ;
  3412. *
  3413. *-----------------------------------------------------
  3414. * Calcul des parametres de l amas de vapeur
  3415. *-----------------------------------------------------
  3416. *
  3417. YPIU = ( DELTA + ( DB / 2. ))* UTAU * RHOL / MUL ;
  3418. SI ( YPIU &lt;EG 5.) ;
  3419. UBL = YPIU * UTAU ;
  3420. * MESS ' YPIU &lt;EG 5. ' ;
  3421. * MESS ' UBL = ' UBL ;
  3422. SINON ;
  3423. SI ( YPIU &lt;EG 30.) ;
  3424. UBL = (( 5. * ( LOG YPIU ) - 3.05 )) * UTAU ;
  3425. * MESS ' YPIU &lt;EG 30. ' ;
  3426. * MESS ' UBL = ' UBL ;
  3427. SINON ;
  3428. UBL = (( 2.5 *( LOG YPIU )) + 5.5 )* UTAU ;
  3429. * MESS ' YPIU > 30. ' ;
  3430. * MESS ' UBL = ' UBL ;
  3431. FINSI ;
  3432. FINSI ;
  3433. RHOV = TAB_1.RRHOV ;
  3434. SI ( NON ( EXISTE TAB_1 FFLOW_HO ) ) ;
  3435. TAB_1 . FFLOW_HO = VRAI ;
  3436. FINSI ;
  3437. SI ( NON ( EXISTE TAB_1 FFLOW_VE ) ) ;
  3438. TAB_1 . FFLOW_VE = FAUX ;
  3439. FINSI ;
  3440. SI ( TAB_1 . FFLOW_HO EGA VRAI ) ;
  3441. UB = UBL ;
  3442. FINSI ;
  3443. SI ( TAB_1 . FFLOW_VE EGA VRAI ) ;
  3444. CD = (2./3.) * DB /(( SIGM /( 9.81 *( RHOL - RHOV )))**(1./2.)) ;
  3445. PI = 3.1415926 ;
  3446. C1 = (( 4.* PI * 9.81 *( RHOL + RHOV ) * ( RHOL - RHOV )) /(( RHOL **2 )* RHOV * CD)) ** (1./2.) ;
  3447. UB1 = ( UBL + ((( UBL **2 ) + ( 4. * C1))**(1./2.)))/2. ;
  3448. UB2 = ( UBL - ((( UBL **2 ) + ( 4. * C1))**(1./2.)))/2. ;
  3449. *UB2<0 toujours
  3450. UB = UB1 ;
  3451. *MESS ' CD = ' CD ;
  3452. *MESS ' C1 = ' C1 ;
  3453. FINSI ;
  3454. *MESS ' UB = ' UB ;
  3455. BLB = (2.*PI*SIGM*(RHOL+RHOV))/(RHOL*RHOV*(UB**2)) ;
  3456. SI (UB &lt;EG 0.) ;
  3457. MESS 'UB<=0 *** ' ;
  3458. IFLAG = 1 ;
  3459. QUITTER QCALCO ;
  3460. FINSI ;
  3461. TAU = BLB/UB ;
  3462. *MESS ' TAU = ' TAU ;
  3463. *MESS ' IFLAG = ' IFLAG ;
  3464. * MESS ' VAPOR BLANKET VELOCITY (m/s) : ' UB ;
  3465. * MESS ' VAPOR BLANKET LENGTH (m) : ' BLB ;
  3466. FINPROC DELTA UB UBL BLB TAU IFLAG ;
  3467. *
  3468. *_____________________________________________________________________________
  3469. *
  3470. **** QUQU
  3471. DEBPROC QUQU TAB_1*TABLE Q*FLOTTANT ;
  3472. *
  3473. DELTA = 0. ;
  3474. UB = 0. ;
  3475. UBL = 0. ;
  3476. BLB = 0. ;
  3477. TAU = 0. ;
  3478. DELTA UB UBL BLB TAU IFLAG = QCALCO TAB_1 Q ;
  3479. SI (IFLAG NEG 0) ;
  3480. * MESS ' On quitte la procedure QUQU sans definir FQ ';
  3481. QUITTER QUQU ;
  3482. FINSI ;
  3483. LLV = TAB_1.LLLV ;
  3484. RHOL = TAB_1.RRHOL ;
  3485. *MESS 'DELTA =' DELTA ;
  3486. *MESS 'RHOL =' RHOL ;
  3487. *MESS 'LLV =' LLV ;
  3488. *MESS 'TAU =' TAU ;
  3489. *MESS 'UB =' UB ;
  3490. *MESS 'UBL =' UBL ;
  3491. *MESS 'Q ='Q ;
  3492. FQ = Q - ( DELTA * RHOL * LLV / TAU) ;
  3493. FINPROC FQ IFLAG ;
  3494. *
  3495. *_____________________________________________________________________________
  3496. *
  3497. **** SECANTI
  3498. DEBPROC SECANTI TAB_1*TABLE X1*FLOTTANT X2*FLOTTANT X1MIN*FLOTTANT ERRMAX*FLOTTANT NMAX*ENTIER ;
  3499. *
  3500. SI (OU (X1 >EG 10.E10) (X2 >EG 10.E10)) ;
  3501. IFLAG = 1 ;
  3502. FINSI ;
  3503. SI (IFLAG NEG 0) ;
  3504. QUITTER SECANTI ;
  3505. FINSI ;
  3506. I = 0 ;
  3507. F1 IFLAG1 = QUQU TAB_1 X1 ;
  3508. F2 IFLAG2 = QUQU TAB_1 X2 ;
  3509. *MESS ' F1 = ' F1 ;
  3510. *MESS ' F2 = ' F2 ;
  3511. XPREC = 0. ;
  3512. REPETER BOUC4(NMAX) ;
  3513. SI (OU (X1 >EG 10.E10) (X2 >EG 10.E10)) ;
  3514. IFLAG = 1 ;
  3515. FINSI ;
  3516. SI (X1 &lt;EG X1MIN) ;
  3517. X1 = X1MIN ;
  3518. FINSI ;
  3519. SI (IFLAG NEG 0) ;
  3520. QUITTER SECANTI ;
  3521. FINSI ;
  3522. X3 = X2-(F2*(X1-X2)/(F1-F2)) ;
  3523. ERR = (ABS ((XPREC-X3)/X3))*100 ;
  3524. F3 IFLAG3 = QUQU TAB_1 X3 ;
  3525. * MESS ' F3 = ' F3 ;
  3526. SI ((ERR &lt;EG ERRMAX) ET (F3 &lt;EG 1.E-3)) ;
  3527. QUITTER SECANTI ;
  3528. FINSI ;
  3529. XPREC = X3 ;
  3530. I = I + 1 ;
  3531. SI ((F1*F3) < 0.) ;
  3532. SI ((F2*F3) < 0.) ;
  3533. A1 = ABS (F3-F1) ;
  3534. A2 = ABS (F3-F2) ;
  3535. SI (A1 > A2) ;
  3536. X1 = X3 ;
  3537. F1 = F3 ;
  3538. SINON ;
  3539. X2 = X3 ;
  3540. F2 = F3 ;
  3541. FINSI ;
  3542. SINON ;
  3543. X2 = X3 ;
  3544. F2 = F3 ;
  3545. FINSI ;
  3546. SINON ;
  3547. SI ((F2*F3) > 0.) ;
  3548. A1 = ABS (F3-F1) ;
  3549. A2 = ABS (F3-F2) ;
  3550. SI (A1 > A2) ;
  3551. X1 = X3 ;
  3552. F1 = F3 ;
  3553. SINON ;
  3554. X2 = X3 ;
  3555. F2 = F3 ;
  3556. FINSI ;
  3557. SINON ;
  3558. X1 = X3 ;
  3559. F1 = F3 ;
  3560. FINSI ;
  3561. FINSI ;
  3562. FIN BOUC4 ;
  3563. *MESS ' X3 = ' X3 ;
  3564. FINPROC X3 ERR IFLAG ;
  3565. *_____________________________________________________________________________
  3566. *
  3567. **** @CELAT94
  3568. DEBPROC @CELAT94 TAB_1*TABLE ;
  3569. *
  3570. * --- entrees
  3571. *
  3572. NIVEAU = TAB_1.'NIVEAU';
  3573. SI (NIVEAU >EG 4);
  3574. MESS '---------------> calling @CELAT94';
  3575. FINSI ;
  3576.  
  3577. PROP_PHY TAB_1 ;
  3578. *
  3579. NORADICI = 0 ;
  3580. *DQ = 2.E3 ;
  3581. DQ = 2.E6 ;
  3582. Q1 = 0. ;
  3583. *Q1 = 20.E6 ;
  3584. REPETER BOUC2 ;
  3585. * MESS '---> BOUC2 ' ;
  3586. QQ = Q1 ;
  3587. IFLAG = 0 ;
  3588. QQ = QQ + DQ ;
  3589. FQ IFLAG = QUQU TAB_1 QQ ;
  3590. * MESS 'FQ =' FQ ;
  3591. * MESS '--------------------------IFLAG =' IFLAG ;
  3592. REPETER BOUC1 ;
  3593. * MESS '--> BOUC1 ' ;
  3594. SI (IFLAG &lt;EG 0) ;
  3595. QUITTER BOUC1 ;
  3596. FINSI ;
  3597. IFLAG = 0 ;
  3598. QQ = QQ + DQ ;
  3599. FQ IFLAG = QUQU TAB_1 QQ ;
  3600. FIN BOUC1 ;
  3601. SI (FQ >EG 0.) ;
  3602. QUITTER BOUC2 ;
  3603. SINON ;
  3604. SI (DQ < 1.E-2) ;
  3605. MESS '---> QUQU HAS NO ZERO ' ;
  3606. NORADICI = 1 ;
  3607. QUITTER BOUC2 ;
  3608. FINSI ;
  3609. Q1 = QQ - DQ ;
  3610. DQ = DQ / 2. ;
  3611. * MESS ' --------QQ = ' QQ ;
  3612. * MESS ' --------Q1 = ' Q1 ;
  3613. * MESS ' FQ = ' FQ ;
  3614. FINSI ;
  3615. FIN BOUC2 ;
  3616. *
  3617. *MESS '--->BOUC3' ;
  3618. *MESS ' **************************** ' ;
  3619. *MESS ' **************************** ' ;
  3620. *MESS ' **************************** ' ;
  3621. *MESS ' **************************** ' ;
  3622. *MESS ' **************************** ' ;
  3623. Q1 = QQ ;
  3624. Q1MIN = Q1 ;
  3625. Q2 = QQ + DQ ;
  3626. *MESS 'Q1 ='Q1 ;
  3627. *MESS 'Q1MIN =' Q1MIN ;
  3628. *MESS 'Q2 =' Q2 ;
  3629. *MESS 'DQ =' DQ ;
  3630. *MESS 'NORADICI =' NORADICI ;
  3631. REPETER BOUC3 ;
  3632. SI (NORADICI EGA 1) ;
  3633. QUITTER BOUC3 ;
  3634. FINSI ;
  3635. IFLAG = 0 ;
  3636. ERRMAX = 0.00001 ;
  3637. SI (OU (Q1 >EG 10.E10) (Q2 >EG 10.E10)) ;
  3638. MESS ' WARNING Q1 OR Q2 EXCEEDED MAXIMUM VALUE ' ;
  3639. QUITTER BOUC3 ;
  3640. FINSI ;
  3641. QCAL ERR IFLAG = SECANTI TAB_1 Q1 Q2 Q1MIN ERRMAX 500 ;
  3642. SI (IFLAG NEG 0) ;
  3643. MESS ' PARAMETER PROBLEM IN TEST ' ;
  3644. IFLAG = 0 ;
  3645. FINSI ;
  3646. SI (QCAL EGA 0.) ;
  3647. QUITTER BOUC3 ;
  3648. FINSI ;
  3649. QUITTER BOUC3 ;
  3650. FIN BOUC3 ;
  3651. *
  3652. MESS 'CELATA94 CRITICAL HEAT FLUX (W/m2) : 'QCAL ;
  3653. *
  3654. QCHFW = QCAL ;
  3655. DELTA = 0. ;
  3656. UB = 0. ;
  3657. UBL = 0. ;
  3658. BLB = 0. ;
  3659. Q1 = 0. ;
  3660. Q2 = 0. ;
  3661. QCAL = 0. ;
  3662. *
  3663. TAB_1.CHF = QCHFW ;
  3664. SI (NIVEAU >EG 4);
  3665. MESS '---------------> exiting @CELAT94';
  3666. FINSI ;
  3667. *FINPROC QCHFW ;
  3668. FINPROC ;
  3669. **** @CERI
  3670. DEBPROC @CERI P_1*POINT P_2*POINT P_3*POINT R_1*FLOTTANT ;
  3671. X_1 = COOR 1 P_1 ;
  3672. Y_1 = COOR 2 P_1 ;
  3673. X_2 = COOR 1 P_2 ;
  3674. Y_2 = COOR 2 P_2 ;
  3675. X_3 = COOR 1 P_3 ;
  3676. Y_3 = COOR 2 P_3 ;
  3677. X_I = (X_1 + X_2 ) / 2. ;
  3678. Y_I = (Y_1 + Y_2 ) / 2. ;
  3679. A_1 = (( X_1 - X_2 ) ** 2 ) + (( Y_1 - Y_2 ) ** 2 ) / 4. ;
  3680. R_12 = R_1 ** 2 ;
  3681. REPETER BLO1 1 ;
  3682. SI ( A_1 EGA R_12 1.E-6 ) ;
  3683. PS_1 = X_I Y_I ;
  3684. P_4 = PS_1 PLUS (( Y_1 - Y_I) ( X_I - X_1)) ;
  3685. X_4 = COOR 1 P_4 ;
  3686. Y_4 = COOR 2 P_4 ;
  3687. PSCAL_1 = ((X_I - X_4) * (X_I - X_3)) + ((Y_I - Y_4) * (Y_I - Y_3)) ;
  3688. SI (PSCAL_1 > 0. ) ;
  3689. P_4 = PS_1 MOIN (( Y_1 - Y_I) ( X_I - X_1)) ;
  3690. FINSI ;
  3691. C_ERC1 = (CERC P_1 PS_1 P_4) ET (CERC P_4 PS_1 P_2);
  3692. QUITTER BLO1 ;
  3693. FINSI ;
  3694.  
  3695. SI ( ( X_1 - X_2 ) NEG 0. 1.E-6) ;
  3696.  
  3697. B_1 = (( Y_1 - Y_2 ) ** 2 ) / (( X_1 - X_2 ) ** 2 ) + 1. ;
  3698. SI ( A_1 < R_12) ;
  3699.  
  3700. YS_1 = Y_I + (((R_12 - A_1) / B_1) ** 0.5 ) ;
  3701. XS_1 = X_I - ((YS_1 - Y_I)*(Y_1 - Y_2 )/(X_1 - X_2 )) ;
  3702. PS_1 = XS_1 YS_1 ;
  3703. PSCAL_1 = ((X_I - XS_1) * (X_I - X_3)) + ((Y_I - YS_1) * (Y_I - Y_3)) ;
  3704. SI (PSCAL_1 < 0. ) ;
  3705. YS_2 = Y_I - (((R_12 - A_1) / B_1) ** 0.5 ) ;
  3706. XS_2 = X_I - ((YS_2 - Y_I)*(Y_1 - Y_2 )/(X_1 - X_2 )) ;
  3707. PS_1 = XS_2 YS_2 ;
  3708. FINSI ;
  3709. C_ERC1 = CERC P_1 PS_1 P_2 ;
  3710. SINON ;
  3711.  
  3712. ERRE '>>@CERI>> DISTANCE ENTRE LES 2 POINTS SUPERIEUR AU DIAMETRE ' ;
  3713. FINSI ;
  3714.  
  3715. SINON ;
  3716. B_1 = (( Y_1 - Y_2 ) ** 2 ) + 1. ;
  3717. R_12 = R_1 ** 2 ;
  3718. YS_1 = Y_I + (((R_12 ) / B_1) ** 0.5 ) ;
  3719. XS_1 = X_I - ((YS_1 - Y_I)*(Y_2 - Y_1 )) ;
  3720. PS_1 = XS_1 YS_1 ;
  3721. PSCAL_1 = ((X_I - XS_1) * (X_I - X_3)) + ((Y_I - YS_1) * (Y_I - Y_3)) ;
  3722. SI (PSCAL_1 < 0. ) ;
  3723. YS_2 = Y_I - (((R_12 ) / B_1) ** 0.5) ;
  3724. XS_2 = X_I - ((YS_2 - Y_I)*(Y_2 - Y_1 )) ;
  3725. PS_1 = XS_2 YS_2 ;
  3726. FINSI ;
  3727. C_ERC1 = CERC P_1 PS_1 P_2 ;
  3728. FINSI ;
  3729. FIN BLO1 ;
  3730. FINPROC C_ERC1 PS_1 ;
  3731.  
  3732.  
  3733. *-----------------------------------------------------------------------
  3734. * Procedure CFLUXTOT
  3735. *-----------------------------------------------------------------------
  3736. DEBPROC CFLUXTOT TAB1*TABLE;
  3737. *
  3738. ***********************************************************************
  3739. * CFLUXTOT developpee par Nicolas URAGO (avr-sept 1994) *
  3740. * largement revisitee par Jacques SCHLOSSER et Alain MOAL (aout 1995) *
  3741. ***********************************************************************
  3742. ******* ATTENTION --> Cette procedure ne tourne qu'en 3D et ne peut
  3743. * traiter que des cas de limiteurs plancher car
  3744. * Z (point tangent) = Z (centre du plasma)
  3745. *
  3746. MESS '---------------------------------> calling CFLUXTOT';
  3747. *
  3748. *-------------------- VARIABLES D'ENTREE
  3749. LPAT1 = TAB1.LFLUX_EXTE ;
  3750. GRP1 = TAB1.GRAND_RAYON ;
  3751. IMESS = TAB1.'NIVEAU' ;
  3752. PTG = TAB1.'PT_TGPLASMA';
  3753. MODEL0 = TAB1.'MODELF' ;
  3754. LAMBQ = TAB1.LAMDAQ ;
  3755. LISFLU = TAB1.LIS_FLUX ;
  3756. OEIL0 = TAB1.VIEW_P ;
  3757. *
  3758. SI (EXISTE TAB1 ANGLE_DEC) ;
  3759. PSI = TAB1.ANGLE_DEC ;
  3760. SINON;
  3761. PSI = 0.0 ;
  3762. FINSI;
  3763. *---------------------------------------
  3764. *
  3765. *---- On calcule pour chaque point de LPAT1, les coordonnees
  3766. *---- de son'centre plasma'.
  3767. XP1 = COOR 1 LPAT1 ;
  3768. YP1 = COOR 2 LPAT1 ;
  3769. ZP1 = COOR 3 LPAT1 ;
  3770. GRAYP1 = (XP1**2 + (YP1**2))**0.5 ;
  3771. XCP1 = XP1 * GRP1 / GRAYP1 ;
  3772. YCP1 = YP1 * GRP1 / GRAYP1 ;
  3773. *
  3774. AUX1 = ((XCP1 - XP1)**2 + ((YCP1 - YP1)**2))**0.5;
  3775. BETA1 = ATG (AUX1/ZP1) ;
  3776. ALPHA2 = ATG YCP1 XCP1 ;
  3777. *
  3778. *---- le vecteur tangent aux lignes de champ B est orthogonal
  3779. *---- a V = P1CP1
  3780. VX1 = XCP1 - XP1 ;
  3781. VY1 = YCP1 - YP1 ;
  3782. VZ1 = ZP1 * -1. ;
  3783. *
  3784. *---- B appartient au plan defini par les vecteurs K (0, 0, 1) et U
  3785. *UX1 = SIN (PSI + ALPHA2) ;
  3786. *UY1 = (COS (PSI + ALPHA2)) * -1. ;
  3787. *UZ1 = UX1 * 0. ;
  3788. *
  3789. UX1 = SIN (PSI - ALPHA2) ;
  3790. UY1 = COS (PSI - ALPHA2) ;
  3791. UZ1 = UX1 * 0. ;
  3792. *
  3793. *---- calcul de B
  3794. BZ = ((VZ1*UX1)**2 + ((VZ1*UY1)**2)) / ((VX1*UX1 + (VY1*UY1))**2) + 1. ;
  3795. BZ = BZ**(-0.5) * -1.;
  3796. BY = BZ * (VZ1*UY1) /(VX1*UX1 + (VY1*UY1)) * -1. ;
  3797. BX = BY * UX1 / UY1 ;
  3798. *
  3799. *---- Calcul du produit scalaire : VECTEUR TANGENT . NORMALE
  3800. NX NY NZ = @VNORM3D (EXTR MODEL0 'MAIL') LPAT1 IMESS ;
  3801. COS_BN = ABS ((BX*NX) + (BY*NY) + (BZ*NZ)) ;
  3802. *
  3803. *---- Coordonnees du point de tangence
  3804. XREF1 = COOR 1 PTG ;
  3805. YREF1 = COOR 2 PTG ;
  3806. ZREF1 = COOR 3 PTG ;
  3807. *
  3808. *---- Centre du plasma au dessus du point de tangence
  3809. XCREF1 = XREF1 * GRP1 / ((XREF1**2 + (YREF1**2))**0.5);
  3810. YCREF1 = YREF1 * GRP1 / ((XREF1**2 + (YREF1**2))**0.5);
  3811. *
  3812. *---- DREF1 est le petit rayon du plasma
  3813. DREF1 = (((XREF1-XCREF1)**2) + ((YREF1-YCREF1)**2) + (ZREF1**2))**.5;
  3814. DIST1 = (((XP1 - XCP1)**2) + ((YP1 - YCP1)**2) + (ZP1**2))**.5;
  3815. *
  3816. *---- Distance a la DSMF
  3817. LDEC1 = DIST1 - DREF1 ;
  3818. *
  3819. *---- Calcul du profil de flux
  3820. VPAT1 = COS_BN * (EXP (LDEC1/(-1.*LAMBQ))) ;
  3821. VFP1 = FLUX MODEL0 VPAT1 ;
  3822. *
  3823. *---- Visualisations
  3824. ARET0 = ARETE LPAT1 ;
  3825. TITRE 'CFLUXTOT : B.N = COSINUS OF THE INCIDENCE ANGLE';
  3826. TRAC OEIL0 COS_BN LPAT1 ARET0;
  3827. TITRE 'CFLUXTOT : TANGENT VECTOR TO THE MAGNETIC LINE';
  3828. VB = @CVECT BX BY BZ LPAT1 VERT;
  3829. TRAC OEIL0 VB LPAT1 ;
  3830. TITRE 'CFLUXTOT : DISTANCE TO THE LCFS' ;
  3831. TRAC OEIL0 LDEC1 LPAT1 ARET0;
  3832. TITRE 'CFLUXTOT : PROFILE OF THE INCIDENT FLUX' ;
  3833. TRAC OEIL0 VPAT1 LPAT1 ARET0;
  3834. *
  3835. *-------------------- VARIABLES EN SORTIE
  3836. *---- flux moyen et puissance
  3837. TAB1.V_SOM1 = (EXTR LISFLU (DIME LISFLU)) * (MAXI (RESU VFP1));
  3838. TAB1.V_FACFM2 = (MAXI (RESU VFP1)) / (MESU LPAT1) ;
  3839. *-----------------------------------------
  3840. *
  3841. MESS '---------------------------------> exiting CFLUXTOT';
  3842. FINPROC VPAT1 ;
  3843.  
  3844.  
  3845.  
  3846.  
  3847.  
  3848. **** @CFPFLU
  3849.  
  3850. DEBPROC @CFPFLU TAB1*TABLE ;
  3851. *
  3852. **************************************************************
  3853. * Procedure de calcul du profil du depot de puissance sur un *
  3854. * objet avec la configuration magnetique de JET. *
  3855. * Alain MOAL (Janvier - Avril 2001) *
  3856. **************************************************************
  3857. * Modif : *
  3858. * 08/11/01 (A.MOAL) : nouveau nom (JETFLU devient CFPFLU) *
  3859. * 08/11/01 (A.MOAL) : calcul de la puissance reelle deposee *
  3860. * 23/11/01 (A.MOAL) : trace de dpsi sur le maillage *
  3861. * 06/12/01 (A.MOAL) : indicateur du passage dans cfpflu *
  3862. * 27/01/04 (A.MOAL) : suppression de l'indicateur <CFPFLU *
  3863. **************************************************************
  3864. *
  3865. MESS '---------------------------------> calling @CFPFLU';
  3866. *
  3867. *---- Valeurs par defaut, verification des indices de la table
  3868. @VDEFJET TAB1 ;
  3869. *
  3870. *--------------- VARIABLES D'ENTREE :
  3871. MAIL0 = TAB1.<MAILLAGE ;
  3872. MMAIL0 = TAB1.MODELF ;
  3873. CONT0 = TAB1.LFLUX_EXTE ;
  3874. IMESS = TAB1.<IMESS ;
  3875. ITRAC = TAB1.<ITRAC ;
  3876. ITYPDEP = TAB1.<TYPE_DEPOT ;
  3877. SI (NON (EXISTE TAB1 <NXM)) ;
  3878. ICALNORM = VRAI ;
  3879. SINON ;
  3880. ICALNORM = FAUX ;
  3881. NXM = TAB1.<NXM ;
  3882. NYM = TAB1.<NYM ;
  3883. NZM = TAB1.<NZM ;
  3884. FINSI ;
  3885. SI ((VALEUR DIME) EGA 3) ;
  3886. OEIL0 = TAB1.VIEW_P ;
  3887. SINON ;
  3888. CONTDES0 = TAB1.LFLUX_EXTE_DESS ;
  3889. FINSI ;
  3890. ICALINCI = TAB1.<CALCUL_INCIDENCE ;
  3891. PUISTOT0 = TAB1.<PUISSANCE_TOTALE ;
  3892. *------------------------------------
  3893. *
  3894. *TAB1.<CFPFLU = VRAI ;
  3895. *
  3896. *---- lecture de la carte de champ magnetique dans un fichier
  3897. @LECTB TAB1 ;
  3898.  
  3899. *--- trace de dpsi sur le maillage
  3900. TAB1.<MAILLAGE_B = CONT0 ;
  3901. CHDPSI = @DPSI TAB1 ;
  3902. TITRE '@CFPFLU : DPSI ON THE MESH' ;
  3903. LISOV0 = PROG -0.66 -0.33 0. 1. 2. 3. ;
  3904. OPTI ISOV LIGNE ;
  3905. TRAC LISOV0 CHDPSI CONT0 ;
  3906. OPTI ISOV SURFACE ;
  3907. *
  3908. *---- lecture du flux normalise sur une ligne dans un fichier
  3909. @LECTF TAB1 ;
  3910. TITRE '@CFPFLU : MAGNETIC DOMAIN, AREA FOR NORMALIZED FLUX AND STUDIED OBJECT';
  3911. *TRAC (TAB1.<GRILLE_B ET TAB1.<MAILLAGE_FN ET MAIL0) ;
  3912. TRAC ((ENVE TAB1.<GRILLE_B) ET (CONT TAB1.<MAILLAGE_FN) ET (ENVE MAIL0)) ;
  3913. *
  3914. *---- calcul du champ B sur la ligne de reference pour
  3915. *---- verification des angles d'incidences
  3916. SI (ICALINCI) ;
  3917. @VERANG TAB1 ;
  3918. FINSI ;
  3919.  
  3920. TAB1.<MAILLAGE_B = TAB1.<MAILLAGE_FN ;
  3921. BR BZ BPHI = @MAGNB TAB1 ;
  3922. *
  3923. *---- calcul du champ magnetique sur le maillage
  3924. TAB1.<MAILLAGE_B = MAIL0 ;
  3925. BR BZ BPHI = @MAGNB TAB1 ;
  3926.  
  3927. PHI = ATG (COOR 2 MAIL0) (COOR 1 MAIL0) ;
  3928. *AM*11/09/01*BXM = BR * (COS PHI) + (BPHI * (SIN PHI));
  3929. *AM*11/09/01*BYM = BR * (SIN PHI) - (BPHI * (COS PHI));
  3930. BXM = BR * (COS PHI) - (BPHI * (SIN PHI));
  3931. BYM = BR * (SIN PHI) + (BPHI * (COS PHI));
  3932. BZM = BZ ;
  3933. MENAGE ;
  3934. *
  3935. *---- calcul des normales a la surface calculees
  3936. *---- dans le repere du maillage
  3937. SI (ICALNORM) ;
  3938. NXM NYM NZM = @VNORM3D MAIL0 CONT0 ;
  3939. TAB1.<NXM = NXM ;
  3940. TAB1.<NYM = NYM ;
  3941. TAB1.<NZM = NZM ;
  3942. FINSI;
  3943. MENAGE ;
  3944. *
  3945. *---- calcul du produit scalaire et de l'angle d'incidence
  3946. B_NORM = ((BXM*BXM) + (BYM*BYM) + (BZM*BZM))**0.5 ;
  3947. VBVN = (ABS ((BXM*NXM) + (BYM*NYM) + (BZM*NZM))) / B_NORM;
  3948. ANGINCI = ATG ((1.-(VBVN**2))**0.5) VBVN ;
  3949. *
  3950. *---- vecteur champ magnetique et vecteur normal dans le repere
  3951. *---- du maillage en vue de la visualisation
  3952. VB1 = @CVECT BXM BYM BZM CONT0 VERT;
  3953. VN1 = @CVECT NXM NYM NZM CONT0 BLEU;
  3954. *
  3955. *---- dans le plan xy du repere du maillage
  3956. BETA2DXY = ATG (BYM*-1.) (BXM*-1.) ;
  3957. *---- dans le plan xz du repere du maillage
  3958. BETA2DXZ = ATG (BZM*-1.) (BXM*-1.) ;
  3959. *
  3960. *---- calcul de la densite de puissance recue par chaque point
  3961. VAR1 = @FLNORM TAB1 ;
  3962. *
  3963. *---- profil du flux pour une puissance de 1 MW deposee sur l'objet
  3964. *---- (flux parallele ou perpendiculaire)
  3965. SI (ITYPDEP) ;
  3966. PROFIL0 = VAR1 * VBVN ;
  3967. SINON ;
  3968. PROFIL0 = VAR1 * ((1. - (VBVN*VBVN)) ** .5) ;
  3969. FINSI ;
  3970. *
  3971. *---- integration du flux sur la surface
  3972. PROCONT0 = NOMC SCAL (FLUX MMAIL0 PROFIL0) ;
  3973. *
  3974. *---- calcul du flux moyen
  3975. PROMOY = (MAXI (RESU PROCONT0)) / (MESU CONT0) ;
  3976. *
  3977. *---- flux reel deposee pour une puissance donnee en MW
  3978. PROFIL1 = PROFIL0 * PUISTOT0 ;
  3979. *
  3980. *---- traces en 3D
  3981. SI (((VALEUR DIME) EGA 3) ET ITRAC) ;
  3982. SI (EGA (VALEUR ELEM) 'CUB8') ;
  3983. ARET1 = ARETE CONT0 ;
  3984. SINON ;
  3985. ARET1 = ARETE CONT0 40. ;
  3986. FINSI ;
  3987. TITRE '@CFPFLU : MAGNETIC FIELD AND NORMAL VECTOR' ;
  3988. TRACE CACH OEIL0 (VB1 ET VN1) MAIL0 ;
  3989. TITRE '@CFPFLU : COSINUS OF THE ANGLE BETWEEN b AND n' ;
  3990. TRACE 20 CACH OEIL0 VBVN CONT0 ARET1;
  3991. TITRE '@CFPFLU : 90 - ANGLE BETWEEN VECTORS B AND SURFACE (DEGREE)';
  3992. TRACE 20 CACH OEIL0 (90. - ANGINCI) CONT0 ARET1;
  3993. TITRE '@CFPFLU : NORM OF THE MAGNETIC FIELD (TESLA)' ;
  3994. TRACE 20 CACH OEIL0 B_NORM CONT0 ARET1 ;
  3995. * TITRE '@CFPFLU : flux0 * exp (- delta / lamdaq)' ;
  3996. * TRACE 20 CACH OEIL0 VAR1 CONT0 ARET1;
  3997. TITRE '@CFPFLU : INCIDENT HEAT FLUX FOR 'PUISTOT0' MW' ;
  3998. * TRACE 2 0CACH OEIL0 PROFIL0 CONT0 ARET1 ;
  3999. TRACE 20 CACH OEIL0 PROFIL1 CONT0 ARET1 ;
  4000. FINSI ;
  4001.  
  4002. SI (IMESS >EG 2) ;
  4003. MESS '>>>> @CFPFLU : BXM '; MESS (MAXI BXM) (MINI BXM) ;
  4004. MESS '>>>> @CFPFLU : BYM '; MESS (MAXI BYM) (MINI BYM) ;
  4005. MESS '>>>> @CFPFLU : BZM '; MESS (MAXI BZM) (MINI BZM) ;
  4006. MESS '>>>> @CFPFLU : PROFIL0 ';
  4007. MESS (MAXI PROFIL0) (MINI PROFIL0) ;
  4008. MESS '>>>> @CFPFLU : PROFIL1 ';
  4009. MESS (MAXI PROFIL1) (MINI PROFIL1) ;
  4010. MESS '>>>> @CFPFLU : VAR1 '; MESS (MAXI VAR1) (MINI VAR1) ;
  4011. MESS '>>>> @CFPFLU : ANGINCI ';
  4012. MESS (MAXI ANGINCI) (MINI ANGINCI) ;
  4013. FINSI ;
  4014. SI (IMESS >EG 3) ;
  4015. MESS '>>>> @CFPFLU : BXM '; LIST BXM ;
  4016. MESS '>>>> @CFPFLU : BYM '; LIST BYM ;
  4017. MESS '>>>> @CFPFLU : BZM '; LIST BZM ;
  4018. MESS '>>>> @CFPFLU : VBVN '; LIST VBVN ;
  4019. MESS '>>>> @CFPFLU : BETA2DXY '; LIST BETA2DXY ;
  4020. MESS '>>>> @CFPFLU : BETA2DXZ '; LIST BETA2DXZ ;
  4021. MESS '>>>> @CFPFLU : ANGINCI '; LIST ANGINCI ;
  4022. MESS '>>>> @CFPFLU : PROFIL0 '; LIST PROFIL0 ;
  4023. MESS '>>>> @CFPFLU : PROFIL1 '; LIST PROFIL1 ;
  4024. FINSI ;
  4025. *
  4026. *--------------- VARIABLES DE SORTIE :
  4027. TAB1.V_FACFM2 = PROMOY ;
  4028. TAB1.<ANGINCI = ANGINCI ;
  4029. TAB1.<VBVN = VBVN ;
  4030. *TAB1.<CFPFLU = FAUX ;
  4031. *-------------------------------------
  4032. MESS '---------------------------------> exiting @CFPFLU';
  4033. FINPROC PROFIL1 ;
  4034.  
  4035. **** @CHAMB
  4036. DEBPROC @CHAMB TAB1*TABLE XG1*CHPOINT YG1*CHPOINT ZG1*CHPOINT ISHIFT*LOGIQUE IRIPPLE*LOGIQUE ;
  4037. *
  4038. ***********************************************************
  4039. * Procedure de calcul du champ magnetique en chaque point *
  4040. * en utilisant le modele Seigneur-Hertout de ripple avec *
  4041. * prise en compte du shift de Shafranov. *
  4042. * Alain MOAL (juin 1995) *
  4043. ***********************************************************
  4044. *123456789012345678901234567890123456789012345678901234567890123456789012
  4045. * 1 2 3 4 5 6 7
  4046. ***********************************************************
  4047. *
  4048. *MESS '---------------------------------> calling @CHAMB';
  4049. *
  4050. *--------------- VARIABLES D'ENTREE :
  4051. RP = TAB1.<RP ;
  4052. HP = TAB1.<HP ;
  4053. RHO0 = TAB1.<RHO0 ;
  4054. THETA0 = TAB1.<THETA0 ;
  4055. ANGPHI0 = TAB1.<ANGPHI0 ;
  4056. RR = TAB1.<RR ;
  4057. LAMB = TAB1.<LAMB ;
  4058. IPLASMA = TAB1.<IPLASMA ;
  4059. COEFA = TAB1.<COEFA ;
  4060. COEFB = TAB1.<COEFB ;
  4061. COEFC = TAB1.<COEFC ;
  4062. EPS = TAB1.<EPS ;
  4063. NBOB = TAB1.<NBOB ;
  4064. NSPI = TAB1.<NSPI ;
  4065. INTENS = TAB1.<INTENS ;
  4066. IMESS = TAB1.<IMESS ;
  4067. ICHAMP = TAB1.<MODEL_CHAMP ;
  4068. *------------------------------------
  4069. *
  4070. PI = 3.141592 ;
  4071. MU0 = PI * 4.E-7 ;
  4072. *
  4073. *---- Coordonnees de chaque point dans le repere du plasma
  4074. RHOP THETAP PHIP = @CRGTC XG1 YG1 ZG1 RP HP ;
  4075. *
  4076. *---- Masque delimitant le domaine de validite du modele de ripple
  4077. *attention domaine de validite etendu de 110 a 180 par
  4078. *E.COSTA/E.TSITRONE le 02/06/97
  4079. *MASK0 = (ABS THETAP) MASQUE INFERIEUR 110. ;
  4080. MASK0 = (ABS THETAP) MASQUE INFERIEUR 181. ;
  4081.  
  4082. *
  4083. *SI (NON ISHIFT) ;
  4084. * LAMB = -1. ;
  4085. *FINSI ;
  4086. *
  4087. *---- Calcul dans le repere du plasma des composantes du champ
  4088. *---- poloidal induit par le courant circulant dans le plasma
  4089. AUX0 = -1. * MU0 * IPLASMA / (2. * PI) ;
  4090. *
  4091. SI (EGA ICHAMP 'SEIGNEUR') ;
  4092. BPOL_RHO = (RHOP ** -2) * (RHO0**2) - 1. ;
  4093. BPOL_RHO = BPOL_RHO * (LAMB + 0.5) + (LOG (RHOP / RHO0)) ;
  4094. BPOL_RHO = BPOL_RHO * (SIN THETAP) * AUX0 / (2. * RP) ;
  4095. *
  4096. BPOL_THE = ((RHOP ** -2) * (RHO0**2)) + 1. ;
  4097. BPOL_THE = BPOL_THE * (LAMB + 0.5) - 1. + (LOG (RHOP / RHO0));
  4098. BPOL_THE = BPOL_THE * RHOP * (COS THETAP) / (2. * RP) + 1. ;
  4099. BPOL_THE = BPOL_THE * (RHOP ** -1) * AUX0 ;
  4100. FINSI ;
  4101. *
  4102. SI (EGA ICHAMP 'SHAFRANOV') ;
  4103. * ---- cette formulation a ma preference, les 2 autres semblent
  4104. * douteuses (A.MOAL)
  4105. BPOL_RHO = ((RHOP ** -2) * (RHO0**2) - 1.) * -1. ;
  4106. BPOL_RHO = BPOL_RHO * (LAMB + 0.5) + (LOG (RHOP / RHO0)) ;
  4107. BPOL_RHO = BPOL_RHO * (SIN THETAP) * AUX0 / (2. * RP) ;
  4108. *
  4109. BPOL_THE = ((RHOP ** -2) * (RHO0**2)) + 1. ;
  4110. BPOL_THE = BPOL_THE * (LAMB + 0.5) - 1. + (LOG (RHOP / RHO0));
  4111. BPOL_THE = BPOL_THE * RHOP * (COS THETAP) / (2. * RP) + 1. ;
  4112. BPOL_THE = BPOL_THE * (RHOP ** -1) * AUX0 ;
  4113. FINSI ;
  4114. *
  4115. SI (EGA ICHAMP 'ARTSIMOVICH') ;
  4116. BPOL_RHO = ((RHOP ** -2) * (RHO0**2) - 1.) * -1. ;
  4117. BPOL_RHO = BPOL_RHO * (LAMB + 0.5) + (LOG (RHOP / RHO0)) ;
  4118. BPOL_RHO = BPOL_RHO * (SIN THETAP) * AUX0 / (2. * RP) ;
  4119. *
  4120. BPOL_THE = ((RHOP ** -2) * (RHO0**2)) + 1. ;
  4121. BPOL_THE = BPOL_THE * (LAMB + 0.5) - 1. + (LOG (RHOP / RHO0));
  4122. BPOL_THE = BPOL_THE * (COS THETAP) / 2. + 1. ;
  4123. BPOL_THE = BPOL_THE * AUX0 / RP ;
  4124. FINSI ;
  4125. *
  4126. SI (NON ISHIFT) ;
  4127. BPOL_THE = ((RHOP * 2. * PI / (MU0 * IPLASMA))**(-1))*(-1.) ;
  4128. BPOL_RHO = BPOL_THE * 0. ;
  4129. FINSI ;
  4130. *
  4131. BPOL_PHI = RHOP * 0. ;
  4132. *
  4133. *---- Passage dans la base cartesienne de la machine
  4134. BXPOL BYPOL BZPOL = @CBTGV BPOL_RHO BPOL_THE BPOL_PHI THETAP PHIP ;
  4135. *
  4136. *---- Coordonnees de chaque point dans le "repere du ripple"
  4137. RHOR THETAR PHIR = @CRGTC XG1 YG1 ZG1 RR 0. ;
  4138. *
  4139. SI IRIPPLE ;
  4140. * ---- Calcul dans le repere adapte au calcul du ripple du champ
  4141. * ---- cree par les bobines toroidales
  4142. *
  4143. * ---- 1) calcul de la coordonnee radiale dans le plan meridien Phi=0
  4144. * ---- de la ligne de champ consideree par une methode de point fixe
  4145. RHO_OLD = RHOR ;
  4146. KAUX = (EXP(THETAR**2 * -1. * COEFC)) * ((COS((PHIR + ANGPHI0) * NBOB)) * -1. + 1.) * COEFA ;
  4147. I = 0 ;
  4148. IMAX = 50 ;
  4149. REPETER BOUCLE IMAX ;
  4150. I = I + 1;
  4151. RHO_NEW = RHOR + (KAUX * (EXP(RHO_OLD * COEFB))) ;
  4152. * MESS ' ITERATIONS NUMBER : ' I ;
  4153. * MESS (maxi RHO_NEW ) ;
  4154. SI ((MAXI (ABS((RHO_NEW - RHO_OLD) / RHO_NEW))) &lt;EG EPS) ;
  4155. * MESS ' ITERATIONS NUMBER : ' I ;
  4156. QUITTER BOUCLE ;
  4157. FINSI ;
  4158. RHO_OLD = RHO_NEW ;
  4159. FIN BOUCLE ;
  4160. SI (I >EG IMAX) ;
  4161. MESS '>>> @CHAMB : NO CONVERGENCE OF THE ITERATIVE METHOD !';
  4162. MESS '>>> PROPOSED SOLUTIONS : ' ;
  4163. MESS '>>> 1) INCREASE THE CONVERGENCE CRITERIUM (TAB1.<EPS) ';
  4164. MESS '>>> 2) CHECK YOU ARE WITHIN MODEL VALIDITY DOMAIN ';
  4165. MESS '>>> 3) ASK FOR THE PROCEDURE CONCEPTOR ';
  4166. *EC* ERRE ' >>> STOP IN @CHAMB';
  4167. ERRE ' >>> STOP IN @CHAMB';
  4168. FINSI ;
  4169. RHOMER = RHO_NEW ;
  4170. *
  4171. * ---- 2) composantes du champ (modele Hertout-Seigneur)
  4172. DRHOMER = (EXP(RHOMER * COEFB)) * (EXP(THETAR**2 * COEFC * -1.)) * COEFA ;
  4173. FINSI ;
  4174. RAUX1 = RHOR * (COS THETAR) + RR ;
  4175. *
  4176. *---- champ toroidal moyen sur le cercle de rayon Rr
  4177. BPHI0 = -1. * MU0 * INTENS * NBOB * NSPI / (2. * PI * RR) ;
  4178. *
  4179. *---- champ toroidal moyen sur le cercle de rayon
  4180. * (Rr + Rhor * cos Thetar)
  4181. BTPHI0 = (RAUX1 ** -1.) * BPHI0 * RR ;
  4182. *
  4183. SI IRIPPLE ;
  4184.  
  4185. *EC mai 1997* BTOR_PHI = RHOR / (RAUX1*RHOR) + COEFB ;
  4186. BTOR_PHI = RR / (RAUX1*RHOR) + COEFB ;
  4187.  
  4188. *AM* BTOR_PHI = ((RHOR * RAUX1)**-1) * (RAUX1 * -1. + (2.*RR)) + COEFB;
  4189.  
  4190. BTOR_PHI = BTOR_PHI * -1. * DRHOMER * (COS((PHIR + ANGPHI0) * NBOB)) + 1. ;
  4191.  
  4192. BTOR_PHI = MASK0 * BTOR_PHI * BTPHI0 + ((1.-MASK0) * BTPHI0);
  4193. *
  4194.  
  4195. BTOR_RHO = MASK0 * (RAUX1 ** -1.) * DRHOMER * BTPHI0 * (SIN((PHIR + ANGPHI0) * NBOB)) * NBOB * (-1.) ;
  4196.  
  4197.  
  4198. *
  4199. BTOR_THE = RHOR * 0. ;
  4200. *
  4201. RHOMER = MASK0 * RHOMER + ((1.-MASK0) * RHOR) ;
  4202. SINON ;
  4203. BTOR_PHI = BTPHI0 ;
  4204. BTOR_RHO = RHOR * 0. ;
  4205. BTOR_THE = RHOR * 0. ;
  4206. RHOMER = RHOR ;
  4207. FINSI ;
  4208.  
  4209. *
  4210. *---- Passage dans la base cartesienne de la machine
  4211. BXTOR BYTOR BZTOR = @CBTGV BTOR_RHO BTOR_THE BTOR_PHI THETAR PHIR ;
  4212. *
  4213. *---- Normes du champ poloidal et du champ toroidal
  4214. N_BPOL = (BXPOL*BXPOL + (BYPOL*BYPOL) + (BZPOL*BZPOL))**0.5 ;
  4215. N_BTOR = (BXTOR*BXTOR + (BYTOR*BYTOR) + (BZTOR*BZTOR))**0.5 ;
  4216. *
  4217. *---- Facteur de securite
  4218. FSECU = (RHOP / (RHOP*(COS THETAP)+RP)) * (N_BTOR / N_BPOL) ;
  4219. *
  4220. *---- Champ total
  4221. SI (EXISTE TAB1 MOAL1) ;
  4222. BXPOL = BXPOL*0.;
  4223. BYPOL = BYPOL*0.;
  4224. BZPOL = BZPOL*0.;
  4225. FINSI ;
  4226. SI (EXISTE TAB1 MOAL2) ;
  4227. BXTOR = BXTOR*0.;
  4228. BYTOR = BYTOR*0.;
  4229. BZTOR = BZTOR*0.;
  4230. FINSI ;
  4231. BX = BXPOL + BXTOR ;
  4232. BY = BYPOL + BYTOR ;
  4233. BZ = BZPOL + BZTOR ;
  4234. *
  4235. *---- Messages de verification du calcul
  4236. SI (IMESS >EG 2) ;
  4237. MESS '>>>> @CHAMB ' ;
  4238. MESS 'max and min of the BPOL components in RP' ;
  4239. MESS (MAXI BPOL_RHO) (MINI BPOL_RHO) ;
  4240. MESS (MAXI BPOL_THE) (MINI BPOL_THE) ;
  4241. MESS (MAXI BPOL_PHI) (MINI BPOL_PHI) ;
  4242. MESS 'max and min of the BTOR components in RR' ;
  4243. MESS (MAXI BTOR_RHO) (MINI BTOR_RHO) ;
  4244. MESS (MAXI BTOR_THE) (MINI BTOR_THE) ;
  4245. MESS (MAXI BTOR_PHI) (MINI BTOR_PHI) ;
  4246. MESS 'max and min of the BPOL components' ;
  4247. MESS (MAXI BXPOL) (MINI BXPOL) ;
  4248. MESS (MAXI BYPOL) (MINI BYPOL) ;
  4249. MESS (MAXI BZPOL) (MINI BZPOL) ;
  4250. MESS 'max and min of the BTOR components' ;
  4251. MESS (MAXI BXTOR) (MINI BXTOR) ;
  4252. MESS (MAXI BYTOR) (MINI BYTOR) ;
  4253. MESS (MAXI BZTOR) (MINI BZTOR) ;
  4254. MESS 'max and min of Rho, Theta, Phi in RP';
  4255. MESS (MAXI RHOP) (MINI RHOP) ;
  4256. MESS (MAXI THETAP) (MINI THETAP) ;
  4257. MESS (MAXI PHIP) (MINI PHIP) ;
  4258. MESS 'max and min of X, Y, Z ';
  4259. MESS (MAXI XG1) (MINI XG1) ;
  4260. MESS (MAXI YG1) (MINI YG1) ;
  4261. MESS (MAXI ZG1) (MINI ZG1) ;
  4262. FINSI ;
  4263. SI (IMESS >EG 3) ;
  4264. MESS '>>>> @CHAMB : BPOL_RHO in RP '; LIST BPOL_RHO;
  4265. MESS '>>>> @CHAMB : BPOL_THE in RP '; LIST BPOL_THE;
  4266. MESS '>>>> @CHAMB : BPOL_PHI in RP '; LIST BPOL_PHI;
  4267. MESS '>>>> @CHAMB : BTOR_RHO in RR '; LIST BTOR_RHO;
  4268. MESS '>>>> @CHAMB : BTOR_THE in RR '; LIST BTOR_THE;
  4269. MESS '>>>> @CHAMB : BTOR_PHI in RR '; LIST BTOR_PHI;
  4270. MESS '>>>> @CHAMB : BXPOL '; LIST BXPOL;
  4271. MESS '>>>> @CHAMB : BYPOL '; LIST BYPOL;
  4272. MESS '>>>> @CHAMB : BZPOL '; LIST BZPOL;
  4273. MESS '>>>> @CHAMB : BXTOR '; LIST BXTOR;
  4274. MESS '>>>> @CHAMB : BYTOR '; LIST BYTOR;
  4275. MESS '>>>> @CHAMB : BZTOR '; LIST BZTOR;
  4276. MESS '>>>> @CHAMB : BTOR_THE in RR '; LIST BTOR_THE;
  4277. MESS '>>>> @CHAMB : BTOR_PHI in RR '; LIST BTOR_PHI;
  4278. MESS '>>>> @CHAMB : X '; LIST XG1;
  4279. MESS '>>>> @CHAMB : Y '; LIST YG1;
  4280. MESS '>>>> @CHAMB : Z '; LIST ZG1;
  4281. MESS '>>>> @CHAMB : RHO in RP '; LIST RHOP;
  4282. MESS '>>>> @CHAMB : THETA in RP '; LIST THETAP;
  4283. MESS '>>>> @CHAMB : PHI in RP '; LIST PHIP;
  4284. MESS '>>>> @CHAMB : RHO in RR '; LIST RHOR;
  4285. MESS '>>>> @CHAMB : THETA in RR '; LIST THETAR;
  4286. MESS '>>>> @CHAMB : PHI in RR '; LIST PHIR;
  4287. MESS '>>>> @CHAMB : RHOMER '; LIST RHOMER ;
  4288. MESS '>>>> @CHAMB : BPHI0 ' ; LIST BPHI0 ;
  4289. FINSI ;
  4290. *
  4291. *MESS '---------------------------------> exiting @CHAMB';
  4292. *
  4293. *--------------- VARIABLES DE SORTIE :
  4294. TAB1.<RHOMER = RHOMER ;
  4295. TAB1.<BXPOL = BXPOL ;
  4296. TAB1.<BYPOL = BYPOL ;
  4297. TAB1.<BZPOL = BZPOL ;
  4298. TAB1.<BXTOR = BXTOR ;
  4299. TAB1.<BYTOR = BYTOR ;
  4300. TAB1.<BZTOR = BZTOR ;
  4301. *-------------------------------------
  4302. FINPROC BX BY BZ FSECU;
  4303.  
  4304. **** @CRLTC
  4305. DEBPROC @CRLTC TAB1*TABLE XM*CHPOINT YM*CHPOINT ZM*CHPOINT R*FLOTTANT ;
  4306. *
  4307. ***************************************************************
  4308. * Procedure de changement de repere, on passe des *
  4309. * coordonnees cartesiennes dans le repere de local de l'objet *
  4310. * XM YM ZM repere defini par TAB1.<RHO0, TAB1.<THETA0 et *
  4311. * TAB1.<RP aux coordonnees pseudo-toroidales defini par un *
  4312. * grand rayon donne R . Alain MOAL (mai 1995) *
  4313. ***************************************************************
  4314. *
  4315. *--------------- VARIABLES D'ENTREE :
  4316. RHO0 = TAB1.<RHO0 ;
  4317. THETA0 = TAB1.<THETA0 ;
  4318. RP = TAB1.<RP ;
  4319. *------------------------------------
  4320. *
  4321. CT0 = COS THETA0 ;
  4322. ST0 = SIN THETA0 ;
  4323. MST0 = ST0 * -1. ;
  4324. *
  4325. *---- 1) rotation d'angle THETA0 autour de l'axe X
  4326. X1 = XM ;
  4327. Y1 = (YM * CT0) + (ZM * ST0) ;
  4328. Z1 = (YM * MST0) + (ZM * CT0) ;
  4329. *
  4330. *---- 2) changement d'origine vers le centre du tore,
  4331. *---- rotation de 180 degres autour de l'axe Z2 pour
  4332. *---- retrouver le repere global puis calcul de PHI
  4333. X2 = X1 ;
  4334. Y2 = Y1 - (RHO0 * CT0 + RP) ;
  4335. Z2 = Z1 + (RHO0 * ST0) ;
  4336. *
  4337. X2 = X2 * -1. ;
  4338. Y2 = Y2 * -1. ;
  4339. PHI = ATG (X2 * -1.) Y2 ;
  4340. *
  4341. *---- 3) rotation d'angle PHI autour de l'axe Z2
  4342. CPHI = COS PHI ;
  4343. SPHI = SIN PHI ;
  4344. MSPHI = SPHI * -1. ;
  4345. X3 = (X2 * CPHI) + (Y2 * SPHI) ;
  4346. Y3 = (X2 * MSPHI) + (Y2 * CPHI) ;
  4347. Z3 = Z2 ;
  4348. *
  4349. *---- 4) changement d'origine vers le centre du nouveau repere
  4350. X4 = X3 ;
  4351. Y4 = Y3 - R ;
  4352. Z4 = Z3 ;
  4353. *
  4354. *---- calcul de RHO et THETA
  4355. RHO = ((Y4 * Y4) + (Z4 * Z4))**0.5 ;
  4356. THETA = ATG Z4 Y4 ;
  4357. *
  4358. MESS '>>>> @CRLTC : max and min of the angle PHI' ;
  4359. MESS (MAXI PHI) (MINI PHI) ;
  4360. *
  4361. FINPROC RHO THETA PHI ;
  4362. **** @CRTLC
  4363. DEBPROC @CRTLC R*FLOTTANT RHO*CHPOINT THETA*CHPOINT PHI*CHPOINT TAB1*TABLE ;
  4364. *
  4365. ***************************************************************
  4366. * Procedure de changement de repere, on passe des coordonnees *
  4367. * pseudo-toroidales centrees sur un grand rayon R aux *
  4368. * coordonnees cartesiennes dans le repere de la structure *
  4369. * modelisee. Alain MOAL (mai 1995) *
  4370. ***************************************************************
  4371. *
  4372. *--------------- VARIABLES D'ENTREE :
  4373. RHO0 = TAB1.<RHO0 ;
  4374. THETA0 = TAB1.<THETA0 ;
  4375. RP = TAB1.<RP ;
  4376. *------------------------------------
  4377. *
  4378. CT0 = COS THETA0 ;
  4379. ST0 = SIN THETA0 ;
  4380. MST0= ST0 * -1. ;
  4381. CPHI = COS PHI ;
  4382. SPHI = SIN PHI ;
  4383. MSPHI = SPHI * -1. ;
  4384. *
  4385. X4 = RHO * 0. ;
  4386. Y4 = RHO * (COS THETA) ;
  4387. Z4 = RHO * (SIN THETA) ;
  4388. *
  4389. *---- 1) changement d'origine vers le centre du tore
  4390. X3 = X4 ;
  4391. Y3 = Y4 + R ;
  4392. Z3 = Z4 ;
  4393. *
  4394. *---- 2) rotation d'angle - PHI autour de l'axe Z3
  4395. * puis rotation de - 180 degres autour de l'axe Z2
  4396. X2 = (X3 * CPHI) + (Y3 * MSPHI) ;
  4397. Y2 = (X3 * SPHI) + (Y3 * CPHI) ;
  4398. Z2 = Z3 ;
  4399. *
  4400. X2 = X2 * -1. ;
  4401. Y2 = Y2 * -1. ;
  4402. *
  4403. *---- 3) changement d'origine vers le centre d'objet
  4404. X1 = X2 ;
  4405. Y1 = Y2 + RP + (RHO0 * CT0) ;
  4406. Z1 = Z2 - (RHO0 * ST0) ;
  4407. *
  4408. *---- 4) rotation d'angle - THETA0 autour de l'axe X1
  4409. XP = X1 ;
  4410. YP = (Y1 * CT0) + (Z1 * MST0) ;
  4411. ZP = (Y1 * ST0) + (Z1 * CT0) ;
  4412. *
  4413. FINPROC XP YP ZP ;
  4414. **** @CRTTC
  4415. DEBPROC @CRTTC R1*FLOTTANT RHO1*CHPOINT THETA1*CHPOINT PHI1*CHPOINT R2*FLOTTANT ;
  4416. *
  4417. ***************************************************************
  4418. * Procedure de changement de repere. On passe d'un repere *
  4419. * pseudo-toroidal defini par son grand rayon R1 a un autre *
  4420. * repere pseudo-toroidal defini par son grand rayon R2. Ces *
  4421. * deux reperes ont la meme orientation toroidale: Phi1 = Phi2 *
  4422. * Alain MOAL (juin 1995) *
  4423. ***************************************************************
  4424. *
  4425. RHO2 = RHO1**2 + ((R1 - R2)**2) ;
  4426. RHO2 = RHO2 + (RHO1*(R1 - R2)*(COS THETA1)*2.) ;
  4427. RHO2 = RHO2**0.5 ;
  4428. *
  4429. AUX1 = RHO1 * (SIN THETA1) ;
  4430. AUX2 = RHO1 * (COS THETA1) - R2 + R1 ;
  4431. THETA2 = ATG AUX1 AUX2 ;
  4432. *
  4433. PHI2 = PHI1 ;
  4434. *
  4435. FINPROC RHO2 THETA2 PHI2 ;
  4436. **** @CRLMC
  4437. DEBPROC @CRLMC XL*CHPOINT YL*CHPOINT ZL*CHPOINT TAB1*TABLE ;
  4438. *
  4439. *******************************************************************
  4440. * Version amelioree de l'ancien @CRLMC rebaptise @ACRLM *
  4441. * Procedure de changement de repere. On passe du repere cartesien *
  4442. * local de l'objet modelise au repere cartesien du maillage. Le *
  4443. * point de tangence au plasma est l'origine du repere local et *
  4444. * l'axe Y est dirige vers le centre du plasma. En 3D, L'axe X du *
  4445. * repere local est dans la direction toroidale. *
  4446. * en 2D cas PHICONS l'axe Z du repere local est l'axe toroidal *
  4447. * en 2D cas THECONS l'axe x du repere local est l'axe toroidal *
  4448. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  4449. *******************************************************************
  4450. *
  4451. *--------------- VARIABLES D'ENTREE :
  4452. CP = TAB1.CENTRE_PLASMA ;
  4453. PTG = TAB1.PT_TGPLASMA ;
  4454. SI ((VALEUR DIME) EGA 2) ;
  4455. SI (EXISTE TAB1 <PLAN) ;
  4456. IPLAN = TAB1.<PLAN ;
  4457. SINON ;
  4458. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  4459. FINSI ;
  4460. SINON ;
  4461. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  4462. DIR1 = TAB1.<DIR_TOROIDAL ;
  4463. SINON ;
  4464. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  4465. FINSI ;
  4466. FINSI ;
  4467. *------------------------------------
  4468. *
  4469. SI ((VALEUR DIME) EGA 2) ;
  4470. VECT0 = CP MOINS PTG ;
  4471. VX VY = COOR VECT0 ;
  4472. *
  4473. * ---- calcul de l'angle de rotation dans le plan XY
  4474. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  4475. ANG1 = 0. ;
  4476. SINON ;
  4477. ANG1 = -1.* (ATG VX VY) ;
  4478. FINSI ;
  4479. *
  4480. XPTG YPTG = COOR PTG ;
  4481. *
  4482. SI (EGA IPLAN 'PHICONS');
  4483. * ---- Coupe 2D a Phi constant
  4484. XL = ZL ;
  4485. ZL = ZL * 0.;
  4486. * ---- rotation
  4487. XL1 = XL * (COS ANG1) + (YL * (-1.) * (SIN ANG1));
  4488. YL1 = XL * (SIN ANG1) + (YL * (COS ANG1));
  4489. FINSI;
  4490. SI (EGA IPLAN 'THECONS');
  4491. * ---- Coupe 2D a Theta constant
  4492. * ---- rotation
  4493. XL1 = XL * (COS ANG1) + (YL * (-1.) * (SIN ANG1));
  4494. YL1 = XL * (SIN ANG1) + (YL * (COS ANG1));
  4495. FINSI;
  4496. * ---- changement d'origine du repere
  4497. XM = XL1 + XPTG ;
  4498. YM = YL1 + YPTG ;
  4499. ZM = YL1 * 0. ;
  4500. *
  4501. SINON ;
  4502. *
  4503. VEC1 = DIR1 / (NORM DIR1) ;
  4504. DIR2 = CP MOINS PTG ;
  4505. VEC2 = DIR2 / (NORM DIR2) ;
  4506. VEC3 = VEC1 PVEC VEC2 ;
  4507. *
  4508. X0 Y0 Z0 = COOR PTG ;
  4509. A1 B1 C1 = COOR VEC1 ;
  4510. A2 B2 C2 = COOR VEC2 ;
  4511. A3 B3 C3 = COOR VEC3 ;
  4512. *
  4513. XM1 = (A1 * XL) + (A2 * YL) + (A3 * ZL) ;
  4514. YM1 = (B1 * XL) + (B2 * YL) + (B3 * ZL) ;
  4515. ZM1 = (C1 * XL) + (C2 * YL) + (C3 * ZL) ;
  4516. *
  4517. XM = XM1 + X0 ;
  4518. YM = YM1 + Y0 ;
  4519. ZM = ZM1 + Z0 ;
  4520. *
  4521. FINSI ;
  4522. FINPROC XM YM ZM ;
  4523. **** @CRMLC
  4524. DEBPROC @CRMLC XM*CHPOINT YM*CHPOINT ZM*CHPOINT TAB1*TABLE ;
  4525. *
  4526. *******************************************************************
  4527. * Version amelioree de l'ancien @CRMLC rebaptise @ACRML *
  4528. * Procedure de changement de repere. On passe du repere cartesien *
  4529. * du maillage au repere cartesien local de l'objet modelise. Le *
  4530. * point de tangence au plasma est l'origine de ce repere et l'axe *
  4531. * l'axe Y final est dirige vers le centre du plasma. *
  4532. * en 3D l'axe x du repere local est donne par la direction *
  4533. * toroidale *
  4534. * en 2D cas PHICONS l'axe Z initial est l'axe toroidal *
  4535. * en 2D cas THECONS l'axe x initial est l'axe toroidal *
  4536. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  4537. *******************************************************************
  4538. *
  4539. *--------------- VARIABLES D'ENTREE :
  4540. CP = TAB1.CENTRE_PLASMA ;
  4541. PTG = TAB1.PT_TGPLASMA ;
  4542. SI ((VALEUR DIME) EGA 2) ;
  4543. SI (EXISTE TAB1 <PLAN) ;
  4544. IPLAN = TAB1.<PLAN ;
  4545. SINON ;
  4546. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  4547. FINSI ;
  4548. SINON ;
  4549. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  4550. DIR1 = TAB1.<DIR_TOROIDAL ;
  4551. SINON ;
  4552. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  4553. FINSI ;
  4554. FINSI ;
  4555. *------------------------------------
  4556. *
  4557. SI ((VALEUR DIME) EGA 2) ;
  4558. VECT0 = CP MOINS PTG ;
  4559. VX VY = COOR VECT0 ;
  4560. *
  4561. * ---- calcul de l'angle de rotation dans le plan XY
  4562. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  4563. ANG1 = 0. ;
  4564. SINON ;
  4565. ANG1 = -1.* (ATG VX VY) ;
  4566. FINSI ;
  4567. *
  4568. XPTG YPTG = COOR PTG ;
  4569. *
  4570. * ---- changement d'origine du repere
  4571. XM1 = XM - XPTG ;
  4572. YM1 = YM - YPTG ;
  4573. * ---- rotation pour aligner l'axe Y avec VECT0
  4574. SI (EGA IPLAN 'PHICONS');
  4575. * ---- Coupe 2D a Phi constant
  4576. XL = XM1 * (COS ANG1) + (YM1 * (SIN ANG1));
  4577. YL = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1));
  4578. ZL = XM * 0. ;
  4579. *
  4580. ZL = XL ;
  4581. XL = XL * 0.;
  4582. FINSI;
  4583. SI (EGA IPLAN 'THECONS');
  4584. * ---- Coupe 2D a Theta constant
  4585. XL = XM1 * (COS ANG1) + (YM1 * (SIN ANG1));
  4586. YL = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1));
  4587. ZL = XM * 0. ;
  4588. FINSI ;
  4589. *
  4590. SINON ;
  4591. *
  4592. VEC1 = DIR1 / (NORM DIR1) ;
  4593. DIR2 = CP MOINS PTG ;
  4594. VEC2 = DIR2 / (NORM DIR2) ;
  4595. VEC3 = VEC1 PVEC VEC2 ;
  4596. *
  4597. X0 Y0 Z0 = COOR PTG ;
  4598. A1 B1 C1 = COOR VEC1 ;
  4599. A2 B2 C2 = COOR VEC2 ;
  4600. A3 B3 C3 = COOR VEC3 ;
  4601. *
  4602. XM1 = XM - X0 ;
  4603. YM1 = YM - Y0 ;
  4604. ZM1 = ZM - Z0 ;
  4605. *
  4606. XL = (A1 * XM1) + (B1 * YM1) + (C1 * ZM1) ;
  4607. YL = (A2 * XM1) + (B2 * YM1) + (C2 * ZM1) ;
  4608. ZL = (A3 * XM1) + (B3 * YM1) + (C3 * ZM1) ;
  4609. *
  4610. FINSI ;
  4611. FINPROC XL YL ZL ;
  4612.  
  4613.  
  4614. **** @CBTLV
  4615. DEBPROC @CBTLV BRHO*CHPOINT BTHETA*CHPOINT BPHI*CHPOINT THETA*CHPOINT PHI*CHPOINT TAB1*TABLE ;
  4616. *
  4617. *********************************************************************
  4618. * Procedure de changement de base pour un vecteur B de coordonnees *
  4619. * BRHO, BPHI, BTHETA dans une base pseudo-toroidale aux coordonnees *
  4620. * cartesiennes BX, BY, BZ dans la base de l'objet. *
  4621. * Alain MOAL (juin 1995) *
  4622. *********************************************************************
  4623. *
  4624. *--------------- VARIABLES D'ENTREE :
  4625. THETA0 = TAB1.<THETA0 ;
  4626. *------------------------------------
  4627. *
  4628. CT = COS THETA ;
  4629. ST = SIN THETA ;
  4630. CT0 = COS THETA0 ;
  4631. ST0 = SIN THETA0 ;
  4632. MST0 = ST0 * -1. ;
  4633. CPHI = COS PHI ;
  4634. SPHI = SIN PHI ;
  4635. MSPHI= SPHI * -1. ;
  4636. *
  4637. *---- 1) rotation de - Theta autour de "l'axe Phi"
  4638. BRHO1 = (CT * BRHO) - (ST * BTHETA) ;
  4639. BTHETA1 = (ST * BRHO) + (CT * BTHETA) ;
  4640. BPHI1 = BPHI ;
  4641. *
  4642. *---- 2) rotation de - Phi autour de "l'axe Theta"
  4643. BRHO2 = (CPHI * BRHO1) + (MSPHI * BPHI1) ;
  4644. BTHETA2 = BTHETA1 ;
  4645. BPHI2 = (SPHI * BRHO1) + (CPHI * BPHI1) ;
  4646. *
  4647. *---- 3) rotation de Theta0 autour de "l'axe Phi"
  4648. BRHO3 = (BRHO2 * CT0) + (BTHETA2 * ST0) ;
  4649. BTHETA3 = (BRHO2 * MST0) + (BTHETA2 * CT0) ;
  4650. BPHI3 = BPHI2 ;
  4651. *
  4652. *---- 4) composantes dans le repere cartesien
  4653. BX = BPHI3 ;
  4654. BY = BRHO3 * -1. ;
  4655. BZ = BTHETA3 ;
  4656. *
  4657. FINPROC BX BY BZ;
  4658. **** @CBLMV
  4659. DEBPROC @CBLMV VXL*CHPOINT VYL*CHPOINT VZL*CHPOINT TAB1*TABLE ;
  4660. *
  4661. ********************************************************************
  4662. * Version amelioree de l'ancien @CBLMV rebaptise @ACBLM *
  4663. * Procedure de changement de base. On passe de la base cartesienne *
  4664. * locale de l'objet modelise a la base cartesienne du maillage. *
  4665. * l'axe Y est dirige du point de tangence au plasma vers le centre *
  4666. * du plasma. En 3D, L'axe X du repere local est dans la direction *
  4667. * toroidale. *
  4668. * en 2D cas PHICONS l'axe Z du repere local est l'axe toroidal *
  4669. * en 2D cas THECONS l'axe x du repere local est l'axe toroidal *
  4670. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  4671. ********************************************************************
  4672. *
  4673. *--------------- VARIABLES D'ENTREE :
  4674. CP = TAB1.CENTRE_PLASMA ;
  4675. PTG = TAB1.PT_TGPLASMA ;
  4676. SI ((VALEUR DIME) EGA 2) ;
  4677. SI (EXISTE TAB1 <PLAN) ;
  4678. IPLAN = TAB1.<PLAN ;
  4679. SINON ;
  4680. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  4681. FINSI ;
  4682. SINON ;
  4683. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  4684. DIR1 = TAB1.<DIR_TOROIDAL ;
  4685. SINON ;
  4686. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  4687. FINSI ;
  4688. FINSI ;
  4689. *------------------------------------
  4690. *
  4691. SI ((VALEUR DIME) EGA 2) ;
  4692. VECT0 = CP MOINS PTG ;
  4693. VX VY = COOR VECT0 ;
  4694. *
  4695. * ---- calcul de l'angle de rotation dans le plan XY
  4696. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  4697. ANG1 = 0. ;
  4698. SINON ;
  4699. ANG1 = -1.* (ATG VX VY) ;
  4700. FINSI ;
  4701. *
  4702. SI (EGA IPLAN 'PHICONS');
  4703. * ---- Coupe 2D a Phi constant
  4704. VXL1 = VZL ;
  4705. VYL1 = VYL ;
  4706. VZL1 = VXL * (-1.);
  4707. * ---- rotation
  4708. VXM = VXL1 * (COS ANG1) + (VYL1 * (-1.) * (SIN ANG1));
  4709. VYM = VXL1 * (SIN ANG1) + (VYL1 * (COS ANG1)) ;
  4710. VZM = VZL1 ;
  4711. FINSI ;
  4712. SI (EGA IPLAN 'THECONS');
  4713. * ---- Coupe 2D a Theta constant
  4714. * ---- rotation
  4715. VXM = VXL * (COS ANG1) + (VYL * (-1.) * (SIN ANG1)) ;
  4716. VYM = VXL * (SIN ANG1) + (VYL * (COS ANG1)) ;
  4717. VZM = VZL ;
  4718. FINSI;
  4719. *
  4720. SINON ;
  4721. *
  4722. VEC1 = DIR1 / (NORM DIR1) ;
  4723. DIR2 = CP MOINS PTG ;
  4724. VEC2 = DIR2 / (NORM DIR2) ;
  4725. VEC3 = VEC1 PVEC VEC2 ;
  4726. *
  4727. A1 B1 C1 = COOR VEC1 ;
  4728. A2 B2 C2 = COOR VEC2 ;
  4729. A3 B3 C3 = COOR VEC3 ;
  4730. *
  4731. VXM = (A1 * VXL) + (A2 * VYL) + (A3 * VZL) ;
  4732. VYM = (B1 * VXL) + (B2 * VYL) + (B3 * VZL) ;
  4733. VZM = (C1 * VXL) + (C2 * VYL) + (C3 * VZL) ;
  4734. *
  4735. FINSI ;
  4736. FINPROC VXM VYM VZM ;
  4737.  
  4738. **** @CBMLV
  4739. DEBPROC @CBMLV VXM*CHPOINT VYM*CHPOINT VZM*CHPOINT TAB1*TABLE ;
  4740. *
  4741. ********************************************************************
  4742. * Version amelioree de l'ancien @CBMLV rebaptise @ACBML *
  4743. * Procedure de changement de base. On passe de la base cartesienne *
  4744. * du maillage a la base cartesienne locale de l'objet modelise. *
  4745. * l'axe Y final est dirige du point de tangence vers le centre du *
  4746. * plasma. En 3D l'axe x du repere local est donne par la direction *
  4747. * toroidale *
  4748. * en 2D cas PHICONS l'axe Z initial est l'axe toroidal *
  4749. * en 2D cas THECONS l'axe x initial est l'axe toroidal *
  4750. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  4751. ********************************************************************
  4752. *
  4753. *--------------- VARIABLES D'ENTREE :
  4754. CP = TAB1.CENTRE_PLASMA ;
  4755. PTG = TAB1.PT_TGPLASMA ;
  4756. SI ((VALEUR DIME) EGA 2) ;
  4757. SI (EXISTE TAB1 <PLAN) ;
  4758. IPLAN = TAB1.<PLAN ;
  4759. SINON ;
  4760. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  4761. FINSI ;
  4762. SINON ;
  4763. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  4764. DIR1 = TAB1.<DIR_TOROIDAL ;
  4765. SINON ;
  4766. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  4767. FINSI ;
  4768. FINSI ;
  4769. *------------------------------------
  4770. *
  4771. SI ((VALEUR DIME) EGA 2) ;
  4772. VECT0 = CP MOINS PTG ;
  4773. VX VY = COOR VECT0 ;
  4774. *
  4775. * ---- calcul de l'angle de rotation dans le plan XY
  4776. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  4777. ANG1 = 0. ;
  4778. SINON ;
  4779. ANG1 = -1.* (ATG VX VY) ;
  4780. FINSI ;
  4781. *
  4782. * ---- rotation pour aligner l'axe Y avec VECT0
  4783. SI (EGA IPLAN 'PHICONS');
  4784. * ---- Coupe 2D a Phi constant
  4785. VXL1 = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  4786. VYL1 = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  4787. VZL1 = VZM ;
  4788. * ---- Coupe 2D a Phi constant
  4789. VXL = VZL1 ;
  4790. VYL = VYL1 ;
  4791. VZL = VXL1 * (-1.);
  4792. FINSI ;
  4793. SI (EGA IPLAN 'THECONS');
  4794. * ---- Coupe 2D a Theta constant
  4795. * ---- rotation
  4796. VXL = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  4797. VYL = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  4798. VZL = VZM ;
  4799. FINSI ;
  4800. *
  4801. SINON ;
  4802. *
  4803. VEC1 = DIR1 / (NORM DIR1) ;
  4804. DIR2 = CP MOINS PTG ;
  4805. VEC2 = DIR2 / (NORM DIR2) ;
  4806. VEC3 = VEC1 PVEC VEC2 ;
  4807. *
  4808. A1 B1 C1 = COOR VEC1 ;
  4809. A2 B2 C2 = COOR VEC2 ;
  4810. A3 B3 C3 = COOR VEC3 ;
  4811. *
  4812. VXL = (A1 * VXM) + (B1 * VYM) + (C1 * VZM) ;
  4813. VYL = (A2 * VXM) + (B2 * VYM) + (C2 * VZM) ;
  4814. VZL = (A3 * VXM) + (B3 * VYM) + (C3 * VZM) ;
  4815. *
  4816. FINSI ;
  4817. FINPROC VXL VYL VZL ;
  4818. **** @CHAQT
  4819. 'DEBPROC' @CHAQT MOD_1*MMODEL MCH_1/MCHAML CHP_1/CHPOINT MM_1/MOT ;
  4820. * modification raph MITTEAU le 22 fevrier 1994 pour
  4821. * que CHAQT ne fasse rien en 3D
  4822.  
  4823. MAI_1 = EXTR MOD_1 'MAIL' ;
  4824. SI (EGA (VALE DIME) 2) ;
  4825. SI ( existe MM_1 ) ;
  4826. MM_11 = MM_1 ;
  4827. SINON ;
  4828. MM_11 = 'MECANIQUE ELASTIQUE ' ;
  4829. FINSI ;
  4830. SI ( existe MCH_1 ) ;
  4831. * M_21 = chan 'NOEUD' MOD_1 ( REDU MCH_1 MAI_1) ;
  4832. M_21 = chan 'NOEUD' MOD_1 ( REDU MCH_1 MOD_1) ;
  4833. CHP_21 = chan 'CHPO' MOD_1 M_21 ;
  4834. FINSI ;
  4835. SI ( existe CHP_1 ) ;
  4836. CHP_21 = (REDU CHP_1 MAI_1) ;
  4837. M_21 = chan CHAM CHP_21 MOD_1 'NOEUD' ;
  4838. FINSI ;
  4839. SI ((NON ( existe CHP_1 )) ET (NON ( existe MCH_1))) ;
  4840. ERRE 'IL FAUT DONNER UN CHPOINT OU UN MCHAML' ;
  4841. FINSI ;
  4842. * MAI_2 = chan tri6 MAI_1 ;
  4843. n_t6 = MAXI (nbel MAI_1 ( MOTS TRI6)) ;
  4844. n_q8 = MAXI (nbel MAI_1 ( MOTS QUA8));
  4845. * MESS 'nbre de Q8:' n_q8 'nbre de TRI6:' n_t6 ;
  4846. SI ( n_q8 > 0 ) ;
  4847. MAI_Q8 = MAI_1 ELEM QUA8 ;
  4848. SI ( n_t6 > 0 ) ;
  4849. MAI_T6 = MAI_1 ELEM TRI6 ;
  4850. MAI_2 = (chan tri6 MAI_Q8) ET MAI_T6 ;
  4851. SINON ;
  4852. MAI_2 = chan tri6 MAI_Q8 ;
  4853. FINSI ;
  4854. * MOD_2 = MODE MAI_2 mecanique elastique ;
  4855. TT_1 = TEXTE MM_11 ;
  4856. MOD_2 = MODE MAI_2 TT_1 ;
  4857. * il faut utiliser diff pour ne faire le proi que sur les noeuds nouveaux
  4858. POI_NEW = DIFF ( CHAN POI1 MAI_1 ) ( CHAN POI1 MAI_2 );
  4859. CHP_22 = @ET CHP_21 ( proi POI_NEW M_21 ) ;
  4860. SINON ;
  4861. MAI_2 = MAI_1 ;
  4862. CHP_22 = CHP_21 ;
  4863. MOD_2 = MOD_1 ;
  4864. FINSI ;
  4865. m_22 = chan cham CHP_22 MOD_2 ;
  4866. SINON;
  4867. m_22 = REDU MCH_1 MOD_1 ;
  4868. MOD_2 = MOD_1;
  4869. MAI_2 = MAI_1 ;
  4870. FINSI ;
  4871.  
  4872. 'FINPROC' m_22 MOD_2 MAI_2 ;
  4873.  
  4874.  
  4875. *----------------------------------------------------------------------*
  4876. * *
  4877. * C H A Q T *
  4878. * --------- *
  4879. * DATE 93/05/07
  4880. * procedure CHAQT (DRFC - J. Schlosser)
  4881. * ------------------------------------------
  4882. *
  4883. * MCHPO2 MAIL2 = CHAQT3D MOD1 OBJET1 MAIL1
  4884. *
  4885. *
  4886. *
  4887. * Objet :
  4888. * _________
  4889. *
  4890. * Etant donne un objet de type MCHAML ou CHPOINT , OBJET1,
  4891. * defini sur un MMODEL massif,MOD1,compose de QUA8 et TRI6 (ou
  4892. * en 3D de CU20 PR15) et un sous ensemble MAIL1 du maillage MAITOT1
  4893. * correspondant a MOD1 ( en 3D par exemple
  4894. * l enveloppe) compose de QUA8 et TRI6. La procedure cree
  4895. * un CHPOINT defini sur un nouveau maillage compose exclusivement
  4896. * de TRI6 afin de pouvoir effectue un trace d isovaleur plus correct
  4897. * ( le QUA8 initial se trouve ainsi transforme en QUA9 avec un point
  4898. * milieu ce qui permet un decoupage en 8 triangles lineaires. Cela
  4899. * revient a approximer la variation quadratique dans l element par
  4900. * une variation bilineaire)
  4901. *
  4902. * *
  4903. * Commentaire
  4904. * _____________
  4905. *
  4906. *
  4907. * MOD1 : objet de type MODE (elements massifs)
  4908. *
  4909. * OBJET1 : objet de type MCHAML ou CHPOINT
  4910. *
  4911. * MAIL1 : objet de type MAILLAGE compose de TRI6 et de QUA8
  4912. *
  4913. * MCHPO2 : objet de type CHPOINT
  4914. *
  4915. * MAIL2 : objet de type MAILLAGE compose de TRI6
  4916. *
  4917. *
  4918. *
  4919. * *
  4920. * Remarque
  4921. * _____________
  4922. *
  4923. *
  4924. * la procedure utilise grosso modo
  4925. * MAIL2 = chan tri6 MAIL1 ;
  4926. * MCHPO2 =proi MAIL2 MCHPO1 ;
  4927. * ce shema brut est optimisee et la procedure ne
  4928. * fait la projection que sur les points nouveaux milieux des QUA8
  4929. * ( malheureusement PROI ne calcule pas dans ce cas les bonnnes valeurs)
  4930. *
  4931. * Attention on voit que l on passe par l intermediaire d un CHPOINT
  4932. * les valeurs vont se trouver moyennees aux interfaces des materiaux
  4933. * si vous le souhaitez, procedez materiau par materiau !
  4934. * l' OBJET1 est REDUIT a MOD_1 a l entree de la procedure
  4935. *----------------------------------------------------------------------*
  4936. *123456789012345678901234567890123456789012345678901234567890123456789012
  4937. * 1 2 3 4 5 6 7
  4938. 'DEBPROC' CHAQT3D MOD_1*MMODEL MCH_1/MCHAML CHP_1/CHPOINT MAI_1*MAILLAGE ;
  4939. MAITOT1 = EXTR MOD_1 'MAIL' ;
  4940. SI ( existe MCH_1 ) ;
  4941. M_21 = REDU MCH_1 MOD_1 ;
  4942. M_21 = chan 'NOEUD' MOD_1 M_21 ;
  4943. CHP_21 = chan 'CHPO' MOD_1 M_21 ;
  4944. CHP_20 = REDU CHP_21 MAI_1 ;
  4945. FINSI ;
  4946. SI ( existe CHP_1 ) ;
  4947. CHP_20 = REDU CHP_1 MAI_1 ;
  4948. CHP_21 = REDU CHP_1 MAITOT1 ;
  4949. M_21 = chan CHAM CHP_21 MOD_1 'NOEUD' ;
  4950. * M_21 = chan CHAM CHP_21 MOD_1 'STRESSES' ;
  4951. FINSI ;
  4952. SI ((NON ( existe CHP_1 )) ET (NON ( existe MCH_1))) ;
  4953. ERRE 'IL FAUT DONNER UN CHPOINT OU UN MCHAML' ;
  4954. FINSI ;
  4955. *
  4956. n_t6 = MAXI (nbel MAI_1 ( MOTS TRI6)) ;
  4957. n_q8 = MAXI (nbel MAI_1 ( MOTS QUA8));
  4958. MESS 'nbre de Q8:' n_q8 'nbre de TRI6:' n_t6 ;
  4959. SI ( n_q8 > 0 ) ;
  4960. MAI_Q8 = MAI_1 ELEM QUA8 ;
  4961. SI ( n_t6 > 0 ) ;
  4962. MAI_T6 = MAI_1 ELEM TRI6 ;
  4963. MAI_2 = (chan tri6 MAI_Q8) ET MAI_T6 ;
  4964. SINON ;
  4965. MAI_2 = chan tri6 MAI_Q8 ;
  4966. FINSI ;
  4967.  
  4968. * il faut utiliser diff pour ne faire le proi que sur les noeuds nouveaux
  4969. POI_NEW = DIFF ( CHAN POI1 MAI_1 ) ( CHAN POI1 MAI_2 );
  4970. * trac ( 1.e5 5.e4 -1.e5 ) CHP_20 MAI_1 ;
  4971. * trac ( 1.e5 5.e4 -1.e5 ) M_21 MOD_1 MAI_1 ;
  4972. * trac ( 1.e5 5.e4 -1.e5 ) ( MAI_1 et POI_NEW );
  4973. * trac face ( 1.e5 5.e4 -1.e5 ) MAI_2 ;
  4974. CHP_22 = CHP_20 ET ( proi POI_NEW M_21 ) ;
  4975. * trac ( 1.e5 5.e4 -1.e5 ) CHP_22 MAI_2 ;
  4976.  
  4977. SINON ;
  4978. MAI_2 = MAI_1 ;
  4979. CHP_22 = CHP_21 ;
  4980. FINSI ;
  4981. 'FINPROC' CHP_22 MAI_2 ;
  4982.  
  4983. ******************************************
  4984. * *
  4985. * procedure CHREP : changement de repere *
  4986. * *
  4987. ******************************************
  4988. DEBPROC CHREP CHOIX*MOT CH_2/CHPOINT CH_M/MCHAML CH_PP2/CHPOINT CH_MP/MCHAML ;
  4989. MESS '----------------------> entree dans CHREP ';
  4990. SI ( EXISTE CH_2);
  4991. CH_1 = CH_2 ;
  4992. CH_PP = CH_PP2 ;
  4993. SINON ;
  4994. CH_1 = CH_M ;
  4995. CH_PP = CH_MP;
  4996. FINSI;
  4997.  
  4998. V1 = VALEUR DIME ;
  4999. MESS'DIMENSION';
  5000. V2 = VALEUR MODE ;
  5001. P = TABLE ;
  5002. P.1 = TABLE ;
  5003. P.2 = TABLE ;
  5004. P.3 = TABLE ;
  5005. S = TABLE ;
  5006. S.1 = TABLE ;
  5007. S.2 = TABLE ;
  5008. S.3 = TABLE ;
  5009. SP = TABLE ;
  5010. SP.1 = TABLE ;
  5011. SP.2 = TABLE ;
  5012. SP.3 = TABLE ;
  5013.  
  5014. LISTCOM1 = EXTR CH_1 'COMP';
  5015. LISTCOM2 = EXTR CH_PP 'COMP';
  5016.  
  5017. MR2D_1 = CHAINE 'TX ' 'TY ' 'NX ' 'NY ' ;
  5018. MR2D_2 = CHAINE 'P11 ' 'P12 ' 'P21 ' 'P22 ' ;
  5019. MR3D_1 = CHAINE 'TX ' 'TY ' 'TZ ' 'NX ' 'NY ' 'NZ ' 'BX ' 'BY ' 'BZ ';
  5020. MR3D_2 = CHAINE 'P11 ' 'P12 ' 'P13 ' 'P21 ' 'P22 ' 'P23 ' 'P31 ' 'P32 ' 'P33 ' ;
  5021. SI ( EGA CHOIX 'CONTRAINTES' ) ;
  5022. MC2D_1 = CHAINE 'SMXX' 'SMYY' 'SMZZ' 'SMXY' ;
  5023. MC2D_2 = CHAINE 'SMRR' 'SMZZ' 'SMTT' 'SMRZ' ;
  5024. MC3D_1 = CHAINE 'SMXX' 'SMYY' 'SMZZ' 'SMXY' 'SMXZ' 'SMYZ' ;
  5025. FINSI ;
  5026. SI ( EGA CHOIX 'DEFORMATIONS' ) ;
  5027. MC2D_1 = CHAINE 'EPXX' 'EPYY' 'EPZZ' 'EPXY' ;
  5028. MC2D_2 = CHAINE 'EPRR' 'EPZZ' 'EPTT' 'EPRZ' ;
  5029. MC3D_1 = CHAINE 'EPXX' 'EPYY' 'EPZZ' 'EPXY' 'EPXZ' 'EPYZ' ;
  5030. FINSI ;
  5031. SI (V1 EGA 2) ;
  5032. MCR1 = CHAINE (EXTR LISTCOM2 1) (EXTR LISTCOM2 2) (EXTR LISTCOM2 3) (EXTR LISTCOM2 4) ;
  5033. MCC1 = CHAINE (EXTR LISTCOM1 1) (EXTR LISTCOM1 2) (EXTR LISTCOM1 3) (EXTR LISTCOM1 4) ;
  5034. MESS '>>>CHREP>>>' MCR1 ;
  5035. MESS '>>>CHREP>>>' MR2D_1 ;
  5036. SI ( NON (( EGA MCR1 MR2D_1) OU ( EGA MCR1 MR2D_2)) ) ;
  5037. MESS '>>>CHREP>>> COMPOSANTES REPERE TROUVEES :' MCR1 ;
  5038. MESS '>>>CHREP>>> AU LIEU DE :' MR2D_1 ;
  5039. MESS '>>>CHREP>>> OU BIEN :' MR2D_2 ;
  5040. ERREUR 'COMP_REP_NON_ADMISES' ;
  5041. FINSI;
  5042. SI ( NON (( EGA MCC1 MC2D_1) OU ( EGA MCC1 MC2D_2)) ) ;
  5043. MESS '>>>CHREP>>> COMPOSANTES REPERE TROUVEES :' MCC1 ;
  5044. MESS '>>>CHREP>>> AU LIEU DE :' MC2D_1 ;
  5045. MESS '>>>CHREP>>> OU BIEN :' MC2D_2 ;
  5046. ERREUR 'COMP_CHAMP_NON_ADMISES' ;
  5047. FINSI;
  5048. FINSI;
  5049. SI (V1 EGA 3) ;
  5050. 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) ;
  5051. MCC1 = CHAINE (EXTR LISTCOM1 1) (EXTR LISTCOM1 2) (EXTR LISTCOM1 3) (EXTR LISTCOM1 4) (EXTR LISTCOM1 5) (EXTR LISTCOM1 6) ;
  5052. SI ( NON ( EGA MCR1 MR3D_1) ) ;
  5053. MESS '>>>CHREP>>> COMPOSANTES REPERE TROUVEES :' MCR1 ;
  5054. MESS '>>>CHREP>>> AU LIEU DE :' MR3D_1 ;
  5055. ERREUR 'COMP_REP_NON_ADMISES' ;
  5056. FINSI;
  5057. SI ( NON ( EGA MCC1 MC3D_1) ) ;
  5058. MESS '>>>CHREP>>> COMPOSANTES REPERE TROUVEES :' MCC1 ;
  5059. MESS '>>>CHREP>>> AU LIEU DE :' MC3D_1 ;
  5060. ERREUR 'COMP_CHAMP_NON_ADMISES' ;
  5061. FINSI;
  5062. FINSI;
  5063.  
  5064. SI (V1 EGA 2);
  5065. P.1 . 1 = EXCO (EXTR LISTCOM2 1) CH_PP SCAL ;
  5066. P.1 . 2 = EXCO (EXTR LISTCOM2 2) CH_PP SCAL ;
  5067. P.2 . 1 = EXCO (EXTR LISTCOM2 3) CH_PP SCAL ;
  5068. P.2 . 2 = EXCO (EXTR LISTCOM2 4) CH_PP SCAL ;
  5069. S.1 . 1 = EXCO (EXTR LISTCOM1 1) CH_1 SCAL ;
  5070. S.1 . 2 = EXCO (EXTR LISTCOM1 4) CH_1 SCAL ;
  5071. S.2 . 1 = S.1 . 2 ;
  5072. S.2 . 2 = EXCO (EXTR LISTCOM1 2) CH_1 SCAL ;
  5073. S.3 . 3 = EXCO (EXTR LISTCOM1 3) CH_1 SCAL ;
  5074. FINSI;
  5075. SI (V1 > 2) ;
  5076. P.1 . 1 = EXCO (EXTR LISTCOM2 1) CH_PP SCAL ;
  5077. P.1 . 2 = EXCO (EXTR LISTCOM2 2) CH_PP SCAL ;
  5078. P.1 . 3 = EXCO (EXTR LISTCOM2 3) CH_PP SCAL ;
  5079. P.2 . 1 = EXCO (EXTR LISTCOM2 4) CH_PP SCAL ;
  5080. P.2 . 2 = EXCO (EXTR LISTCOM2 5) CH_PP SCAL ;
  5081. P.2 . 3 = EXCO (EXTR LISTCOM2 6) CH_PP SCAL ;
  5082. P.3 . 1 = EXCO (EXTR LISTCOM2 7) CH_PP SCAL ;
  5083. P.3 . 2 = EXCO (EXTR LISTCOM2 8) CH_PP SCAL ;
  5084. P.3 . 3 = EXCO (EXTR LISTCOM2 9) CH_PP SCAL ;
  5085. *
  5086. S.1 . 1 = EXCO (EXTR LISTCOM1 1) CH_1 SCAL ;
  5087. S.1 . 2 = EXCO (EXTR LISTCOM1 4) CH_1 SCAL ;
  5088. S.2 . 1 = S.1 . 2 ;
  5089. S.2 . 2 = EXCO (EXTR LISTCOM1 2) CH_1 SCAL ;
  5090. S.3 . 3 = EXCO (EXTR LISTCOM1 3) CH_1 SCAL ;
  5091. S.1 . 3 = EXCO (EXTR LISTCOM1 5) CH_1 SCAL ;
  5092. S.2 . 3 = EXCO (EXTR LISTCOM1 6) CH_1 SCAL ;
  5093. S.3 . 1 = S.1 . 3 ;
  5094. S.3 . 2 = S.2 . 3 ;
  5095.  
  5096. I = 0;
  5097. REPETER BOUCS1 3;
  5098. I = I + 1;
  5099. J = I - 1;
  5100. REPETER BOUCS2 ( 3 + 1 - I );
  5101. J = J + 1;
  5102. SP.I.J = 0.;
  5103. L = 0;
  5104. REPETER BOUCS3 3;
  5105. L = L + 1;
  5106. Q = 0;
  5107. REPETER BOUCS4 3;
  5108. Q = Q + 1;
  5109. SP.I.J = (SP.I.J) + ( (P.I.L) * ( P.J.Q) * (S.L.Q )) ;
  5110. FIN BOUCS4;
  5111. FIN BOUCS3;
  5112. FIN BOUCS2;
  5113. FIN BOUCS1;
  5114. SI ( EGA CHOIX CONTRAINTES);
  5115. 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 );
  5116. SINON;
  5117. 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 );
  5118. FINSI;
  5119.  
  5120. SINON;
  5121. I = 0;
  5122. REPETER BOUCS11 2;
  5123. I = I + 1;
  5124. J = I-1;
  5125. REPETER BOUCS21 (2+1-I);
  5126. J = J + 1;
  5127. SP.I.J = 0. ;
  5128. L = 0;
  5129. REPETER BOUCS31 2;
  5130. L = L + 1;
  5131. Q = 0 ;
  5132. REPETER BOUCS41 2;
  5133. Q = Q + 1;
  5134. SP.I.J = (SP.I.J) + ( (P.I.L) * ( P.J.Q) * (S.L.Q )) ;
  5135. FIN BOUCS41;
  5136. FIN BOUCS31;
  5137. FIN BOUCS21;
  5138. FIN BOUCS11;
  5139. SP.3 . 3 = S.3 . 3;
  5140. SI ( EGA CHOIX CONTRAINTES);
  5141. 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 );
  5142. SINON;
  5143. 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 );
  5144. FINSI;
  5145.  
  5146. FINSI;
  5147. MESS '----------------------> sortie de CHREP ';
  5148. FINPROC CH_2;
  5149. **** @CLAMQ
  5150. DEBPROC @CLAMQ TAB1*TABLE XM*CHPOINT YM*CHPOINT ZM*CHPOINT ISHIFT*LOGIQUE IRIPPLE*LOGIQUE ;
  5151. *
  5152. ***********************************************************
  5153. * Procedure de calcul du parametre Lambdaq necessaire au *
  5154. * calcul du profil du depot de puissance en chaque point *
  5155. * de la surface de la structure modelisee. *
  5156. * Alain MOAL (juin 1995) *
  5157. ***********************************************************
  5158. *
  5159. MESS '---------------------------------> calling @CLAMQ';
  5160. *
  5161. *--------------- VARIABLES D'ENTREE :
  5162. RP = TAB1.<RP ;
  5163. HP = TAB1.<HP ;
  5164. RHO0 = TAB1.<RHO0 ;
  5165. THETA0 = TAB1.<THETA0 ;
  5166. ANGPHI0 = TAB1.<ANGPHI0 ;
  5167. RR = TAB1.<RR ;
  5168. LAMB = TAB1.<LAMB ;
  5169. LAMBQREF = TAB1.<LAMBQREF ;
  5170. THETAREF = TAB1.<THETAREF ;
  5171. IPLASMA = TAB1.<IPLASMA ;
  5172. COEFA = TAB1.<COEFA ;
  5173. COEFB = TAB1.<COEFB ;
  5174. COEFC = TAB1.<COEFC ;
  5175. RHOMER = TAB1.<RHOMER ;
  5176. NBOB = TAB1.<NBOB ;
  5177. IMESS = TAB1.<IMESS ;
  5178. *------------------------------------
  5179. *
  5180. PI = 3.141592 ;
  5181. MU0 = 4.E-7 * PI ;
  5182. *
  5183. *---- Coordonnees de chaque point dans le repere du plasma
  5184. RHOP THETAP PHIP = @CRGTC XM YM ZM RP HP ;
  5185. *
  5186. *---- Masque delimitant le domaine de validite du modele de ripple
  5187. *attention domaine de validite etendu a 180 par E.COSTA et
  5188. *E.TSITRONE le 02/06/97
  5189. *MASK0 = (ABS THETAP) MASQUE INFERIEUR 110. ;
  5190. MASK0 = (ABS THETAP) MASQUE INFERIEUR 180. ;
  5191. *
  5192. SI ISHIFT ;
  5193. AUX0 = -1. * MU0 * IPLASMA / (2. * PI) ;
  5194. *
  5195. BPTHEREF = (((RHOP/RP) * (COS THETAREF) * LAMB) + 1.) * AUX0 ;
  5196. BPTHE = (((COS THETAP) * (RHOP/RP) * LAMB) + 1.) * AUX0 ;
  5197. *
  5198. * ---- facteur de compression des lignes de champ due au shift
  5199. H1 = (RHOP * (COS THETAREF) + RP) * BPTHEREF ;
  5200. H2 = ((COS THETAP) * RHOP + RP) * BPTHE ;
  5201. HS = H2 ** -1 * H1 ;
  5202. SINON ;
  5203. HS = RHOP * 0. + 1. ;
  5204. FINSI ;
  5205. *
  5206. SI IRIPPLE ;
  5207. * ---- enveloppe de la DSMF dans le repere adapte au calcul du ripple
  5208. * ---- Rho0 dans le "repere du ripple"
  5209. RHOR THETAR PHIR = @CRGTC XM YM ZM RR 0. ;
  5210. *
  5211. RHO0R = ((RHO0**2) + ((RP - RR)**2) + (2. * RHO0 * (RP - RR) * (COS THETAP)))**0.5 ;
  5212. RHODSMFR = (EXP((THETAR**2) * -1. * COEFC)) * (EXP(COEFB * RHO0R)) * ((COS((PHIR + ANGPHI0) * NBOB)) - 1.) * COEFA + RHO0R;
  5213. * ---- dans le repere du plasma
  5214. RHODSMFP = RHODSMFR * 2. * (RR - RP) * (COS THETAR) ;
  5215. RHODSMFP = RHODSMFP + ((RR - RP)**2) + (RHODSMFR**2) ;
  5216. RHODSMFP = RHODSMFP**0.5 ;
  5217. RHOMERP = RHOMER * 2. * (RR - RP) * (COS THETAR) ;
  5218. RHOMERP = RHOMERP + ((RR - RP)**2) + (RHOMER**2) ;
  5219. RHOMERP = RHOMERP**0.5 ;
  5220. *
  5221. * ---- facteur de compression des lignes de champ due au ripple
  5222. * ---- Rem : le masque sert a traiter le cas Rhomer = Rho0r
  5223. * ---- dans le repere du ripple
  5224. *AM1** MASQ1 = ((ABS(RHOR - RHODSMFR)) MASQUE INFERIEUR 1.E-6)*1.E-6;
  5225. *AM1** MASQ2 = ((ABS(RHOMER - RHO0R)) MASQUE INFERIEUR 1.E-6)*1.E-6 ;
  5226. *AM1** HR = ((RHOR - RHODSMFR) + MASQ1) / ((RHOMER - RHO0R) + MASQ2) ;
  5227. * ---- dans le repere du plasma
  5228. *AM2** MASQ1 = ((ABS(RHOP - RHODSMFP)) MASQUE INFERIEUR 1.E-6)*1.E-6;
  5229. *AM2** MASQ2 = ((ABS(RHOMERP - RHO0)) MASQUE INFERIEUR 1.E-6)*1.E-6 ;
  5230. *AM2** HR = ((RHOP - RHODSMFP) + MASQ1) / ((RHOMERP - RHO0) + MASQ2);
  5231. *AM*** HR = MASK0 * HR + ((1.-MASK0) * 1.) ;
  5232. * ---- Pas de compression des lignes de champ due au ripple
  5233. HR = RHOP * 0. + 1. ;
  5234. SINON ;
  5235. HR = RHOP * 0. + 1. ;
  5236. FINSI ;
  5237. *
  5238. LAMBQ = HR * HS * LAMBQREF ;
  5239. *
  5240. *---- distance a la derniere surface magnetique avec ripple
  5241. SI IRIPPLE ;
  5242. * ---- dans le repere du plasma
  5243. DELTA = MASK0 * (RHOP - RHODSMFP) + ((1.-MASK0) * (RHOP - RHO0));
  5244. * ---- dans le repere du ripple
  5245. *AM1** DELTA = MASK0 * (RHOR - RHODSMFR) + ((1.-MASK0) * (RHOR - RHO0R));
  5246. SINON ;
  5247. DELTA = RHOP - RHO0 ;
  5248. FINSI ;
  5249. *
  5250. *---- messages de verification
  5251. SI (IMESS >EG 3) ;
  5252. MESS '>>>> in @CLAMQ : RHO0R '; LIST RHO0R ;
  5253. MESS '>>>> in @CLAMQ : RHODSMFR '; LIST RHODSMFR ;
  5254. MESS '>>>> in @CLAMQ : RHO0R '; LIST RHO0R ;
  5255. MESS '>>>> in @CLAMQ : HR '; LIST HR ;
  5256. MESS '>>>> in @CLAMQ : HS '; LIST HS ;
  5257. MESS '>>>> in @CLAMQ : LAMBQ '; LIST LAMBQ ;
  5258. MESS '>>>> in @CLAMQ : DELTA '; LIST DELTA ;
  5259. FINSI ;
  5260. *
  5261. SI (IMESS >EG 2) ;
  5262. MESS '>>>> in @CLAMQ : max and min values of HR ';
  5263. MESS (MAXI HR) (MINI HR) ;
  5264. MESS '>>>> in @CLAMQ : max and min values of HS ';
  5265. MESS (MAXI HS) (MINI HS) ;
  5266. MESS '>>>> in @CLAMQ : max and min values of LAMBQ ';
  5267. MESS (MAXI LAMBQ) (MINI LAMBQ) ;
  5268. MESS '>>>> in @CLAMQ : max and min values of DELTA ';
  5269. MESS (MAXI DELTA) (MINI DELTA) ;
  5270. FINSI ;
  5271. *
  5272. MESS '---------------------------------> exiting @CLAMQ';
  5273. FINPROC LAMBQ HS HR DELTA ;
  5274.  
  5275.  
  5276.  
  5277.  
  5278. **** @CLIGB
  5279. DEBPROC @CLIGB NBPAS0*ENTIER PASB0*FLOTTANT TAB1*TABLE TABLIG1*TABLE IMETHOD*ENTIER;
  5280. *
  5281. *****************************************************************
  5282. * Procedure de calcul des lignes de champ magnetique partant de *
  5283. * chaque point d'une geometrie donnee. *
  5284. * methode 1 : methode explicite (tangentes) *
  5285. * methode 2 : Methode iterative avec convergence sur un critere *
  5286. * d'appartenance a la surface magnetique *
  5287. * Alain MOAL (mars 1996) *
  5288. *****************************************************************
  5289. *
  5290. MESS '---------------------------------> calling @CLIGB';
  5291. *
  5292. * ---- Valeurs par defaut
  5293. @VDEFAUT TAB1 ;
  5294. *
  5295. *--------------- VARIABLES D'ENTREE :
  5296. LISTE0 = TAB1.<LI_LIGNE_B ;
  5297. TYPCAL = TAB1.<TYPE_CALCUL ;
  5298. RP = TAB1.<RP ;
  5299. RR = TAB1.<RR ;
  5300. HP = TAB1.<HP ;
  5301. EPS0 = TAB1.<EPS ;
  5302. COEFA = TAB1.<COEFA ;
  5303. COEFB = TAB1.<COEFB ;
  5304. COEFC = TAB1.<COEFC ;
  5305. NBOB = TAB1.<NBOB ;
  5306. SI (EXISTE TAB1 <LPT) ;
  5307. RHO0 = TAB1.<RHO0 ;
  5308. FINSI ;
  5309. *------------------------------------
  5310. *
  5311. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  5312. ISHIFT = VRAI ;
  5313. IRIPPLE = VRAI ;
  5314. FINSI ;
  5315. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  5316. ISHIFT = VRAI ;
  5317. IRIPPLE = FAUX ;
  5318. FINSI ;
  5319. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  5320. ISHIFT = FAUX ;
  5321. IRIPPLE = VRAI ;
  5322. FINSI ;
  5323. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  5324. ISHIFT = FAUX ;
  5325. IRIPPLE = FAUX ;
  5326. FINSI ;
  5327. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  5328. ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
  5329. FINSI ;
  5330.  
  5331. SI (IMETHOD EGA 1) ;
  5332. * ---- Methode explicite simple (tangentes)
  5333. I0 = 0 ;
  5334.  
  5335. REPETER BOUCLE0 (DIME LISTE0);
  5336.  
  5337. I0 = I0 + 1 ; list I0 ;
  5338. P0 = TEXT (EXTR I0 LISTE0) ;
  5339. XM YM ZM = COOR P0 ;
  5340. TABLIG1.I0 = ((XM+1.E-6) YM ZM) D 1 P0 ;
  5341.  
  5342. * ---- Transformation en champ par point
  5343. XM0 = MANU CHPO P0 1 SCAL XM ;
  5344. YM0 = MANU CHPO P0 1 SCAL YM ;
  5345. ZM0 = MANU CHPO P0 1 SCAL ZM ;
  5346.  
  5347. * ---- Coordonnees dans le repere global du tore
  5348. XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
  5349. *
  5350. I1 = 0 ;
  5351. REPETER BOUCLE1 NBPAS0 ;
  5352. * I1 = I1 + 1 ; MESS 'I1 = ' I1;
  5353. * ---- Calcul du champ dans le repere global
  5354. BXG BYG BZG FSECU = @CHAMB TAB1 XG_OLD YG_OLD ZG_OLD ISHIFT IRIPPLE ;
  5355.  
  5356. NORM_B = ((BXG*BXG) + (BYG*BYG) + (BZG*BZG))**0.5 ;
  5357.  
  5358. XG_NEW = XG_OLD - (BXG * PASB0 / NORM_B) ;
  5359. YG_NEW = YG_OLD - (BYG * PASB0 / NORM_B) ;
  5360. ZG_NEW = ZG_OLD - (BZG * PASB0 / NORM_B) ;
  5361.  
  5362. * ---- Coordonnees dans le repere du maillage
  5363. XM_NEW YM_NEW ZM_NEW = @CRGMC XG_NEW YG_NEW ZG_NEW TAB1 ;
  5364.  
  5365. XM1 = EXTR XM_NEW SCAL P0 ;
  5366. YM1 = EXTR YM_NEW SCAL P0 ;
  5367. ZM1 = EXTR ZM_NEW SCAL P0;
  5368.  
  5369. SI (EXISTE TAB1 <LPT) ;
  5370. * ---- traitement particulier pour le LPT
  5371. * ---- on change la couleur de la ligne qui
  5372. * ---- passe au dessous
  5373. XM2 YM2 ZM2 = @CRGMC XG_OLD YG_OLD ZG_OLD TAB1;
  5374.  
  5375. SI ((ZG_NEW >EG RHO0) ET (ZG_OLD >EG RHO0)) ;
  5376. TABLIG1.I0 = TABLIG1.I0 ET (((XM2 YM2 ZM2) D 1 (XM1 YM1 ZM1)) COUL ROUG);
  5377. SINON ;
  5378. TABLIG1.I0 = TABLIG1.I0 ET (((XM2 YM2 ZM2) D 1 (XM1 YM1 ZM1)) COUL JAUN);
  5379. FINSI ;
  5380. FINSI ;
  5381.  
  5382. TABLIG1.I0 = TABLIG1.I0 D 1 (XM1 YM1 ZM1) ;
  5383.  
  5384. XG_OLD = XG_NEW ;
  5385. YG_OLD = YG_NEW ;
  5386. ZG_OLD = ZG_NEW ;
  5387.  
  5388. MENAGE ;
  5389.  
  5390. FIN BOUCLE1 ;
  5391.  
  5392. * ---- calcul de l'erreur sur Rho
  5393.  
  5394. SI ((NON ISHIFT) ET (NON IRIPPLE)) ;
  5395. * ---- Coordonnees du point initial dans le repere
  5396. * ---- global du tore
  5397. XG0 YG0 ZG0 = @CRMGC XM0 YM0 ZM0 TAB1 ;
  5398.  
  5399. * ---- Coordonnees du point initial dans le repere
  5400. * ---- pseudo-toroidal du plasma
  5401. RHO0 THE0 PHI0 = @CRGTC XG0 YG0 ZG0 RP HP ;
  5402.  
  5403. * ---- Coordonnees du point final dans le repere
  5404. * ---- pseudo-toroidal du plasma
  5405. RHO1 THE1 PHI1 = @CRGTC XG_OLD YG_OLD ZG_OLD RP HP;
  5406.  
  5407. * ---- sans ripple, on doit avoir Rho constant le
  5408. * ---- long de la ligne de champ
  5409. DRHO0 = RHO1 - RHO0 ;
  5410. ERREUR0 = (ABS DRHO0) / RHO0 ;
  5411. MESS 'Variation en Rho : ' ; LIST DRHO0 ;
  5412. MESS 'Erreur en Rho : ' ; LIST ERREUR0 ;
  5413. FINSI ;
  5414.  
  5415. FIN BOUCLE0 ;
  5416. FINSI ;
  5417.  
  5418. SI (IMETHOD EGA 2) ;
  5419. * ---- Methode iterative avec convergence sur un critere
  5420. * ---- d'appartenance a la surface magnetique
  5421. I0 = 0 ;
  5422.  
  5423. REPETER BOUCLE0 (DIME LISTE0);
  5424.  
  5425. I0 = I0 + 1 ;
  5426. P0 = TEXT (EXTR I0 LISTE0) ;
  5427. XM YM ZM = COOR P0 ;
  5428. TABLIG1.I0 = ((XM+1.E-6) YM ZM) D 1 P0 ;
  5429.  
  5430. * ---- Transformation en champ par point
  5431. XM0 = MANU CHPO P0 1 SCAL XM ;
  5432. YM0 = MANU CHPO P0 1 SCAL YM ;
  5433. ZM0 = MANU CHPO P0 1 SCAL ZM ;
  5434.  
  5435. * ---- Coordonnees dans le repere global du tore
  5436. XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
  5437. *
  5438. I1 = 0 ;
  5439. REPETER BOUCLE1 NBPAS0 ;
  5440.  
  5441. I1 = I1 + 1 ; MESS 'I1 = ' I1;
  5442. * ---- Calcul du champ dans le repere global
  5443. BXG BYG BZG FSECU = @CHAMB TAB1 XG_OLD YG_OLD ZG_OLD ISHIFT IRIPPLE ;
  5444.  
  5445. NORM_B = ((BXG*BXG) + (BYG*BYG) + (BZG*BZG))**0.5 ;
  5446.  
  5447. XG_NEW0 = XG_OLD - (BXG * PASB0 / NORM_B) ;
  5448. YG_NEW0 = YG_OLD - (BYG * PASB0 / NORM_B) ;
  5449. ZG_NEW0 = ZG_OLD - (BZG * PASB0 / NORM_B) ;
  5450.  
  5451. * ---- Coordonnees dans le repere
  5452. * ---- pseudo-toroidal du ripple
  5453. RHOR THER PHIR = @CRGTC XG_OLD YG_OLD ZG_OLD RR 0.;
  5454.  
  5455. * ---- calcul de la coordonnee radiale dans le
  5456. * ---- plan meridien Phi=0 de la ligne de champ
  5457. * ---- consideree par une methode de point fixe
  5458. RHOR_OLD = RHOR ;
  5459. KAUX = (EXP(THER**2 * -1. * COEFC)) * ((COS (PHIR * NBOB)) * -1. + 1.) * COEFA ;
  5460. I3 = 0 ;
  5461. REPETER BOUCLE3 50 ;
  5462. I3 = I3 + 1; MESS ' I3 = ' I3;
  5463. RHOR_NEW = RHOR + (KAUX * (EXP(RHOR_OLD * COEFB)));
  5464. SI ((MAXI (ABS((RHOR_NEW - RHOR_OLD) / RHOR_NEW))) &lt;EG EPS0) ;
  5465. QUITTER BOUCLE3 ;
  5466. FINSI ;
  5467. RHOR_OLD = RHOR_NEW ;
  5468. FIN BOUCLE3 ;
  5469.  
  5470. RHOMER = RHOR_NEW ;
  5471.  
  5472. * ---- le point obtenu doit etre sur la surface magnetique
  5473. I2 = 0 ;
  5474. REPETER BOUCLE2 2 ;
  5475. I2 = I2 + 1 ; MESS ' I2 = ' I2;
  5476. * ---- Coordonnees dans le repere
  5477. * ---- pseudo-toroidal du ripple
  5478. RHORN THERN PHIRN = @CRGTC XG_NEW0 YG_NEW0 ZG_NEW0 RR 0.;
  5479.  
  5480. DRHOMERN = (EXP(RHOMER * COEFB)) * (EXP(THERN**2 * COEFC * -1.)) * COEFA ;
  5481.  
  5482. RHORIP = DRHOMERN * ((COS (PHIRN*NBOB)) - 1.) + RHOMER;
  5483.  
  5484. * ---- Coordonnees dans le repere global
  5485. XG_NEW1 YG_NEW1 ZG_NEW1 = @CRTGC RHORIP THERN PHIRN RR 0.;
  5486.  
  5487. * ---- Calcul du champ dans le repere global
  5488. BXG0 BYG0 BZG0 FSECU0 = @CHAMB TAB1 XG_NEW1 YG_NEW1 ZG_NEW1 ISHIFT IRIPPLE ;
  5489.  
  5490. * ---- on prend la moyenne des 2 tangentes
  5491. BXG1 = (BXG + BXG0)/2. ;
  5492. BYG1 = (BYG + BYG0)/2. ;
  5493. BZG1 = (BZG + BZG0)/2. ;
  5494.  
  5495. NORM_B1 = ((BXG1*BXG1) + (BYG1*BYG1) + (BZG1*BZG1))**0.5 ;
  5496.  
  5497. XG_NEW0 = XG_OLD - (BXG1 * PASB0 / NORM_B1) ;
  5498. YG_NEW0 = YG_OLD - (BYG1 * PASB0 / NORM_B1) ;
  5499. ZG_NEW0 = ZG_OLD - (BZG1 * PASB0 / NORM_B1) ;
  5500.  
  5501. SI (I2 EGA 2) ;
  5502. XG_NEW = XG_NEW0 ;
  5503. YG_NEW = YG_NEW0 ;
  5504. ZG_NEW = ZG_NEW0 ;
  5505. FINSI ;
  5506.  
  5507. FIN BOUCLE2 ;
  5508.  
  5509. * ---- Coordonnees dans le repere du maillage
  5510. XM_NEW YM_NEW ZM_NEW = @CRGMC XG_NEW YG_NEW ZG_NEW TAB1 ;
  5511.  
  5512. XG_OLD = XG_NEW ;
  5513. YG_OLD = YG_NEW ;
  5514. ZG_OLD = ZG_NEW ;
  5515.  
  5516. XM1 = EXTR XM_NEW SCAL P0 ;
  5517. YM1 = EXTR YM_NEW SCAL P0 ;
  5518. ZM1 = EXTR ZM_NEW SCAL P0;
  5519.  
  5520. TABLIG1.I0 = TABLIG1.I0 D 1 (XM1 YM1 ZM1) ;
  5521. MENAGE ;
  5522.  
  5523. FIN BOUCLE1 ;
  5524. FIN BOUCLE0 ;
  5525. FINSI ;
  5526. MESS '---------------------------------> exiting @CLIGB';
  5527. FINPROC ;
  5528.  
  5529. **** @CLIGB0
  5530. DEBPROC @CLIGB0 DPHI*FLOTTANT PHIMAX*FLOTTANT TAB1*TABLE TABLIG1*TABLE IMETHOD*ENTIER;
  5531. *
  5532. *****************************************************************
  5533. * Procedure de calcul des lignes de champ magnetique partant de *
  5534. * chaque point d'une geometrie donnee. *
  5535. * methode 1 : methode explicite (tangentes) *
  5536. * methode 2 : Runge-Kutta du 4eme ordre a pas constant *
  5537. * Alain MOAL (mars 1996) *
  5538. *****************************************************************
  5539. *
  5540. MESS '---------------------------------> calling @CLIGB';
  5541. *
  5542. *--------------- VARIABLES D'ENTREE :
  5543. LISTE0 = TAB1.<LI_LIGNE_B ;
  5544. OEIL0 = TAB1.VIEW_P ;
  5545. RP = TAB1.<RP ;
  5546. HP = TAB1.<HP ;
  5547. ANGPHI0 = TAB1.<ANG_PHI0 ;
  5548. TYPCAL = TAB1.<TYPE_CALCUL ;
  5549. *------------------------------------
  5550. *
  5551. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  5552. ISHIFT = VRAI ;
  5553. IRIPPLE = VRAI ;
  5554. FINSI ;
  5555. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  5556. ISHIFT = VRAI ;
  5557. IRIPPLE = FAUX ;
  5558. FINSI ;
  5559. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  5560. ISHIFT = FAUX ;
  5561. IRIPPLE = VRAI ;
  5562. FINSI ;
  5563. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  5564. ISHIFT = FAUX ;
  5565. IRIPPLE = FAUX ;
  5566. FINSI ;
  5567. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  5568. ERRE ' >>>> @CLIGB0 : check the value of TAB1.<TYPE_CALCUL';
  5569. FINSI ;
  5570.  
  5571. * ---- Valeurs par defaut
  5572. @VDEFAUT TAB1 ;
  5573. TABLIG1 = TABLE ;
  5574. *
  5575. SI (IMETHOD EGA 1) ;
  5576. * ---- Methode explicite (tangentes)
  5577. TEMPS ZERO ;
  5578. I0 = 0 ;
  5579. REPETER BOUCLE0 (DIME LISTE0);
  5580.  
  5581. I0 = I0 + 1 ;
  5582. P0 = TEXT (EXTR I0 LISTE0) ;
  5583. XM YM ZM = COOR P0 ;
  5584. TABLIG1.I0 = ((XM+1.E-6) YM ZM) D 1 P0 ;
  5585. *
  5586. * ---- Transformation en champ par point
  5587. XM0 = MANU CHPO P0 1 SCAL XM ;
  5588. YM0 = MANU CHPO P0 1 SCAL YM ;
  5589. ZM0 = MANU CHPO P0 1 SCAL ZM ;
  5590. DPHI0 = MANU CHPO P0 1 SCAL DPHI ;
  5591. *
  5592. * ---- Coordonnees dans le repere global du tore
  5593. XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
  5594. *
  5595. LISTRHO = PROG ;
  5596. LISTTHE = PROG ;
  5597. LISTPHI = PROG ;
  5598. LISTFSE = PROG ;
  5599. *
  5600. PHIAUX = ANGPHI0 ;
  5601. *
  5602. REPETER BOUCLE1 (ENTI (PHIMAX/DPHI)) ;
  5603. *
  5604. PHIAUX = PHIAUX + DPHI ;
  5605. * ---- Numero du grand tour calcule a partir du plan
  5606. * ---- median entre bobines
  5607. NTOUR0 = (ENTI (PHIAUX / 360.)) + 1 ;
  5608. *
  5609. * ---- Calcul du champ dans le repere global
  5610. BX BY BZ FSECU = @CHAMB TAB1 XG_OLD YG_OLD ZG_OLD ISHIFT IRIPPLE ;
  5611. *
  5612. * ---- Coordonnees dans le repere pseudo-toroidal du plasma
  5613. RHO_OLD THE_OLD PHI_OLD = @CRGTC XG_OLD YG_OLD ZG_OLD RP HP ;
  5614. *
  5615. * ---- Champ dans le repere pseudo-toroidal du plasma
  5616. BRHO BTHETA BPHI = @CBGTV BX BY BZ THE_OLD PHI_OLD ;
  5617. *
  5618. DRHO0 = (RHO_OLD * (COS THE_OLD) + RP) * BRHO * DPHI0 / BPHI;
  5619. DTHE0 = (RHO_OLD * (COS THE_OLD) + RP) * BTHETA * DPHI0 / BPHI / RHO_OLD;
  5620.  
  5621. RHO_NEW = RHO_OLD + DRHO0 ;
  5622. THE_NEW = THE_OLD + DTHE0 ;
  5623. * MESS 'PHI_OLD+DPHI0 '; LIST (MAXI (PHI_OLD+DPHI0));
  5624. SI (((MAXI (PHI_OLD+DPHI0)) >EG 0.) ET ((MAXI (PHI_OLD+DPHI0)) &lt;EG 180.));
  5625. PHI_NEW = PHI_OLD + DPHI0 + (360. * (NTOUR0-1));
  5626. FINSI ;
  5627. SI (((MAXI (PHI_OLD+DPHI0)) > -180.) ET ((MAXI (PHI_OLD+DPHI0)) < 0.));
  5628. PHI_NEW = PHI_OLD + DPHI0 + (360. * NTOUR0) ;
  5629. FINSI ;
  5630. SI ((MAXI (PHI_OLD+DPHI0)) > 180.) ;
  5631. PHI_NEW = PHI_OLD + DPHI0 ;
  5632. FINSI ;
  5633.  
  5634. LISTRHO = LISTRHO ET (PROG (MAXI RHO_NEW)) ;
  5635. LISTTHE = LISTTHE ET (PROG (MAXI THE_NEW)) ;
  5636. LISTPHI = LISTPHI ET (PROG (MAXI PHI_NEW)) ;
  5637. LISTFSE = LISTFSE ET (PROG (MAXI FSECU)) ;
  5638. *
  5639. * ---- Coordonnees dans le repere global
  5640. XG_NEW YG_NEW ZG_NEW = @CRTGC RHO_NEW THE_NEW PHI_NEW RP HP;
  5641. *
  5642. MESS 'TOUR : ' ; LIST NTOUR0 ;
  5643. MESS 'MAX DE PHI '; LIST (MAXI PHI_NEW);
  5644. MESS 'MAX DE RHO '; LIST (MAXI RHO_NEW);
  5645. MESS 'MAX DE THE '; LIST (MAXI THE_NEW);
  5646. MESS 'MAX DE FSECU '; LIST (MAXI FSECU);
  5647.  
  5648. * MESS 'MAX DE BPHI '; LIST (MAXI BPHI);
  5649. * MESS 'MAX DE BRHO '; LIST (MAXI BRHO);
  5650. * MESS 'MAX DE BTHE '; LIST (MAXI BTHETA);
  5651.  
  5652. * ---- Coordonnees dans le repere du maillage
  5653. XM_NEW YM_NEW ZM_NEW = @CRGMC XG_NEW YG_NEW ZG_NEW TAB1 ;
  5654. *
  5655. XG_OLD = XG_NEW ;
  5656. YG_OLD = YG_NEW ;
  5657. ZG_OLD = ZG_NEW ;
  5658.  
  5659. XM1 = EXTR XM_NEW SCAL P0 ;
  5660. YM1 = EXTR YM_NEW SCAL P0 ;
  5661. ZM1 = EXTR ZM_NEW SCAL P0;
  5662.  
  5663. TABLIG1.I0 = TABLIG1.I0 D 1 (XM1 YM1 ZM1) ;
  5664.  
  5665. SI ((MAXI PHI_NEW) >EG PHIMAX) ;
  5666. MESS '>>>> The maximum value of Phi is reached';
  5667. QUITTER BOUCLE1 ;
  5668. FINSI ;
  5669. MENAGE ;
  5670.  
  5671. FIN BOUCLE1 ;
  5672.  
  5673. EVRHO = EVOL JAUN MANU 'PHI' LISTPHI 'RHO' LISTRHO ;
  5674. EVTHE = EVOL ROUG MANU 'PHI' LISTPHI 'THETA' LISTTHE ;
  5675. EVFSE = EVOL VERT MANU 'PHI' LISTPHI 'FSECU' LISTFSE ;
  5676. DESSIN EVRHO MIMA ;
  5677. DESSIN EVTHE MIMA ;
  5678. DESSIN EVFSE MIMA ;
  5679. FIN BOUCLE0 ;
  5680. TEMPS ;
  5681. FINSI ;
  5682.  
  5683. SI (IMETHOD EGA 2) ;
  5684. * ---- Runge-Kutta d'ordre 4 a pas constant
  5685. TEMPS ZERO ;
  5686. I0 = 0 ;
  5687. REPETER BOUCLE0 (DIME LISTE0);
  5688.  
  5689. I0 = I0 + 1 ;
  5690. P0 = TEXT (EXTR I0 LISTE0) ;
  5691. XM YM ZM = COOR P0 ;
  5692. TABLIG1.I0 = ((XM+1.E-6) YM ZM) D 1 P0 ;
  5693. *
  5694. * ---- Transformation en champ par point
  5695. XM0 = MANU CHPO P0 1 SCAL XM ;
  5696. YM0 = MANU CHPO P0 1 SCAL YM ;
  5697. ZM0 = MANU CHPO P0 1 SCAL ZM ;
  5698. DPHI0 = MANU CHPO P0 1 SCAL DPHI ;
  5699. *
  5700. * ---- Coordonnees dans le repere global du tore
  5701. XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
  5702. *
  5703. LISTRHO = PROG ;
  5704. LISTTHE = PROG ;
  5705. LISTPHI = PROG ;
  5706. LISTFSE = PROG ;
  5707. *
  5708. PHIAUX = ANGPHI0 ;
  5709. *
  5710. REPETER BOUCLE1 (ENTI (PHIMAX/DPHI)) ;
  5711. *
  5712. PHIAUX = PHIAUX + DPHI ;
  5713. * ---- Numero du grand tour calcule a partir du plan
  5714. * ---- median entre bobine
  5715. NTOUR0 = (ENTI (PHIAUX / 360.)) + 1 ;
  5716. *
  5717. * ---- Calcul du champ dans le repere global
  5718. BX BY BZ FSECU = @CHAMB TAB1 XG_OLD YG_OLD ZG_OLD ISHIFT IRIPPLE ;
  5719.  
  5720. * ---- Coordonnees dans le repere pseudo-toroidal du plasma
  5721. RHO_OLD THE_OLD PHI_OLD = @CRGTC XG_OLD YG_OLD ZG_OLD RP HP ;
  5722.  
  5723. * ---- Champ dans le repere pseudo-toroidal du plasma
  5724. BRHO BTHE BPHI = @CBGTV BX BY BZ THE_OLD PHI_OLD ;
  5725. *
  5726. * ---- calcul de K0 et L0
  5727. K0 = (RHO_OLD * (COS THE_OLD) + RP) * BRHO / BPHI;
  5728. L0 = (RHO_OLD * (COS THE_OLD) + RP) * BTHE / BPHI / RHO_OLD;
  5729.  
  5730. * ---- calcul de K1 et L1
  5731. RHO1_OLD = RHO_OLD + (K0/2.) ;
  5732. THE1_OLD = THE_OLD + (L0/2.) ;
  5733. * SI (((MAXI (PHI_OLD+DPHI0)) >EG 0.) ET
  5734. * ((MAXI (PHI_OLD+DPHI0)) &lt;EG 180.));
  5735. * PHI1_OLD = PHI_OLD + (DPHI0/2.) + (360. * (NTOUR0-1));
  5736. * FINSI ;
  5737. * SI (((MAXI (PHI_OLD+DPHI0)) > -180.) ET
  5738. * ((MAXI (PHI_OLD+DPHI0)) < 0.));
  5739. * PHI1_OLD = PHI_OLD + (DPHI0/2.) + (360. * NTOUR0) ;
  5740. * FINSI ;
  5741. * SI ((MAXI (PHI_OLD+DPHI0)) > 180.) ;
  5742. PHI1_OLD = PHI_OLD + (DPHI0/2) ;
  5743. * FINSI ;
  5744.  
  5745. XG1_OLD YG1_OLD ZG1_OLD = @CRTGC RHO1_OLD THE1_OLD PHI1_OLD RP HP;
  5746.  
  5747. * ---- Calcul du champ dans le repere global
  5748. BX1 BY1 BZ1 FSECU = @CHAMB TAB1 XG1_OLD YG1_OLD ZG1_OLD IRIPPLE ISHIFT ;
  5749.  
  5750. * ---- Champ dans le repere pseudo-toroidal du plasma
  5751. BRHO1 BTHE1 BPHI1 = @CBGTV BX1 BY1 BZ1 THE1_OLD PHI1_OLD ;
  5752.  
  5753. K1 = (RHO1_OLD * (COS THE1_OLD) + RP)*BRHO1 /BPHI1 * DPHI0;
  5754. L1 = (RHO1_OLD * (COS THE1_OLD) + RP)*BTHE1/BPHI1 / RHO1_OLD * DPHI0;
  5755.  
  5756. * ---- calcul de K2 et L2
  5757. RHO2_OLD = RHO_OLD + (K1/2.) ;
  5758. THE2_OLD = THE_OLD + (L1/2.) ;
  5759. * SI (((MAXI (PHI_OLD+DPHI0)) >EG 0.) ET
  5760. * ((MAXI (PHI_OLD+DPHI0)) &lt;EG 180.));
  5761. * PHI2_OLD = PHI_OLD + (DPHI0/2.) + (360. * (NTOUR0-1));
  5762. * FINSI ;
  5763. * SI (((MAXI (PHI_OLD+DPHI0)) > -180.) ET
  5764. * ((MAXI (PHI_OLD+DPHI0)) < 0.));
  5765. * PHI2_OLD = PHI_OLD + (DPHI0/2.) + (360. * NTOUR0);
  5766. * FINSI ;
  5767. * SI ((MAXI (PHI_OLD+DPHI0)) > 180.) ;
  5768. PHI2_OLD = PHI_OLD + (DPHI0/2) ;
  5769. * FINSI ;
  5770.  
  5771. XG2_OLD YG2_OLD ZG2_OLD = @CRTGC RHO2_OLD THE2_OLD PHI2_OLD RP HP;
  5772.  
  5773. * ---- Calcul du champ dans le repere global
  5774. BX2 BY2 BZ2 FSECU = @CHAMB TAB1 XG2_OLD YG2_OLD ZG2_OLD ISHIFT IRIPPLE ;
  5775.  
  5776. * ---- Champ dans le repere pseudo-toroidal du plasma
  5777. BRHO2 BTHE2 BPHI2 = @CBGTV BX2 BY2 BZ2 THE2_OLD PHI2_OLD ;
  5778.  
  5779. K2 = (RHO2_OLD * (COS THE2_OLD) + RP)*BRHO2 /BPHI2 * DPHI0;
  5780. L2 = (RHO2_OLD * (COS THE2_OLD) + RP)*BTHE2/BPHI2 / RHO2_OLD * DPHI0;
  5781.  
  5782. * ---- calcul de K3 et L3
  5783. RHO3_OLD = RHO_OLD + K2 ;
  5784. THE3_OLD = THE_OLD + L2 ;
  5785. * SI (((MAXI (PHI_OLD+DPHI0)) >EG 0.) ET
  5786. * ((MAXI (PHI_OLD+DPHI0)) &lt;EG 180.));
  5787. * PHI3_OLD = PHI_OLD + DPHI0 + (360. * (NTOUR0-1));
  5788. * FINSI ;
  5789. * SI (((MAXI (PHI_OLD+DPHI0)) > -180.) ET
  5790. * ((MAXI (PHI_OLD+DPHI0)) < 0.));
  5791. * PHI3_OLD = PHI_OLD + DPHI0 + (360. * NTOUR0);
  5792. * FINSI ;
  5793. * SI ((MAXI (PHI_OLD+DPHI0)) > 180.) ;
  5794. PHI3_OLD = PHI_OLD + DPHI0 ;
  5795. * FINSI ;
  5796.  
  5797. XG3_OLD YG3_OLD ZG3_OLD = @CRTGC RHO3_OLD THE3_OLD PHI3_OLD RP HP;
  5798.  
  5799. * ---- Calcul du champ dans le repere global
  5800. BX3 BY3 BZ3 FSECU = @CHAMB TAB1 XG3_OLD YG3_OLD ZG3_OLD ISHIFT IRIPPLE ;
  5801.  
  5802. * ---- Champ dans le repere pseudo-toroidal du plasma
  5803. BRHO3 BTHE3 BPHI3 = @CBGTV BX3 BY3 BZ3 THE3_OLD PHI3_OLD ;
  5804.  
  5805. K3 = (RHO3_OLD * (COS THE3_OLD) + RP)*BRHO3 / BPHI3 * DPHI0;
  5806. L3 = (RHO3_OLD * (COS THE3_OLD) + RP)*BTHE3/BPHI3 / RHO3_OLD * DPHI0;
  5807.  
  5808. RHO_NEW = RHO_OLD + ((K0 + (2.*K1) + (2.*K2) + K3)/6.);
  5809. THE_NEW = THE_OLD + ((L0 + (2.*L1) + (2.*L2) + L3)/6.);
  5810.  
  5811. SI (((MAXI (PHI_OLD+DPHI0)) >EG 0.) ET ((MAXI (PHI_OLD+DPHI0)) &lt;EG 180.));
  5812. PHI_NEW = PHI_OLD + DPHI0 + (360. * (NTOUR0-1));
  5813. FINSI ;
  5814. SI (((MAXI (PHI_OLD+DPHI0)) > -180.) ET ((MAXI (PHI_OLD+DPHI0)) < 0.));
  5815. PHI_NEW = PHI_OLD + DPHI0 + (360. * NTOUR0) ;
  5816. FINSI ;
  5817. SI ((MAXI (PHI_OLD+DPHI0)) > 180.) ;
  5818. PHI_NEW = PHI_OLD + DPHI0 ;
  5819. FINSI ;
  5820.  
  5821. LISTRHO = LISTRHO ET (PROG (MAXI RHO_NEW)) ;
  5822. LISTTHE = LISTTHE ET (PROG (MAXI THE_NEW)) ;
  5823. LISTPHI = LISTPHI ET (PROG (MAXI PHI_NEW)) ;
  5824. LISTFSE = LISTFSE ET (PROG (MAXI FSECU)) ;
  5825.  
  5826. * ---- Coordonnees dans le repere global
  5827. XG_NEW YG_NEW ZG_NEW = @CRTGC RHO_NEW THE_NEW PHI_NEW RP HP;
  5828. MESS 'TOUR : ' ; LIST NTOUR0 ;
  5829. MESS 'MAX DE PHI '; LIST (MAXI PHI_NEW);
  5830. MESS 'MAX DE RHO '; LIST (MAXI RHO_NEW);
  5831. MESS 'MAX DE THE '; LIST (MAXI THE_NEW);
  5832. MESS 'MAX DE FSECU '; LIST (MAXI FSECU);
  5833.  
  5834. * ---- Coordonnees dans le repere du maillage
  5835. XM_NEW YM_NEW ZM_NEW = @CRGMC XG_NEW YG_NEW ZG_NEW TAB1 ;
  5836. *
  5837. XG_OLD = XG_NEW ;
  5838. YG_OLD = YG_NEW ;
  5839. ZG_OLD = ZG_NEW ;
  5840.  
  5841. XM1 = EXTR XM_NEW SCAL P0 ;
  5842. YM1 = EXTR YM_NEW SCAL P0 ;
  5843. ZM1 = EXTR ZM_NEW SCAL P0;
  5844.  
  5845. TABLIG1.I0 = TABLIG1.I0 D 1 (XM1 YM1 ZM1) ;
  5846.  
  5847. SI ((MAXI PHI_NEW) >EG PHIMAX) ;
  5848. MESS '>>>> The maximum value of Phi is reached';
  5849. QUITTER BOUCLE1 ;
  5850. FINSI ;
  5851. MENAGE ;
  5852.  
  5853. FIN BOUCLE1 ;
  5854.  
  5855. EVRHO = EVOL JAUN MANU 'PHI' LISTPHI 'RHO' LISTRHO ;
  5856. EVTHE = EVOL ROUG MANU 'PHI' LISTPHI 'THETA' LISTTHE ;
  5857. EVFSE = EVOL VERT MANU 'PHI' LISTPHI 'FSECU' LISTFSE ;
  5858. DESSIN EVRHO MIMA ;
  5859. DESSIN EVTHE MIMA ;
  5860. DESSIN EVFSE MIMA ;
  5861. FIN BOUCLE0 ;
  5862. TEMPS ;
  5863. FINSI ;
  5864.  
  5865. MESS '---------------------------------> exiting @CLIGB0';
  5866. FINPROC ;
  5867.  
  5868. **** CONTACT
  5869. *---------------------------------------------------------------------
  5870. * PROCEDURE CONTACT VERSION DU 15/10/87
  5871. *---------------------------------------------------------------------
  5872. * CETTE PROCEDURE SERT A DEFINIR LE CONTACT ENTRE 2 SOLIDES
  5873. * OU ENTRE 1 SOLIDE ET UN OBSTACLE .
  5874. *
  5875. * SYNTAXE :
  5876. * -------
  5877. *
  5878. *
  5879. * BLC BLT FFF COEF =
  5880. *
  5881. * CONTACT | MINI | NOMINC | POI1 ( POI2 ) |
  5882. * | MAXI | DIRECTION V1 | GEO1 ( GEO2 ) |
  5883. *
  5884. * | CONSTANT | MU ( JEU | VVAL | ) ;
  5885. * | COULOMB | | CHSCA |
  5886. * | CHP |
  5887. *
  5888. *
  5889. * ATTENTION METTRE LES NOMS CONNUS EN 4 LETTRES |
  5890. * EXEMPLE : METTRE DIRE ET NON PAS DIRECTION
  5891. *
  5892. * ( EXPLICATION : CF BLOQUER , RELA ET DEPI )
  5893. *
  5894. * BLC ET BLT: LES BLOCAGES ASSOCIES AU CONTACT
  5895. * ( NORMAUX ET TANGENTIELS )
  5896. * FFF : LE SECOND MEMBRE ( NON NUL SI JEU )
  5897. * COEF : LES COEFFICIENTS DE FROTTEMENT
  5898. *
  5899. *---------------------------------------------------------------------
  5900. 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 ;
  5901. *
  5902. IDIR = 0 ;
  5903. SSDIM = VALE DIME ;
  5904. SI ( EGA DDL DIRE ) ;
  5905. IDIR = 1 ; FINSI ;
  5906. *------------------------------
  5907. * ON RECUPERE LA GEOMETRIE
  5908. *------------------------------
  5909. IDEUX = 0 ;
  5910. SI ( EGA IDIR 0 ) ;
  5911. SI ( EXISTE V1 ) ;
  5912. GEO1 = V1 ;
  5913. SI ( EXISTE POI1 ) ;
  5914. IDEUX = 1 ;
  5915. GEO2 = POI1 ;
  5916. FINSI ;
  5917. FINSI ;
  5918. SINON ;
  5919. SI ( EXISTE POI1 ) ;
  5920. GEO1 = POI1 ;
  5921. SI ( EXISTE POI2 ) ;
  5922. IDEUX = 1 ;
  5923. GEO2 = POI2 ;
  5924. FINSI ;
  5925. FINSI;
  5926. FINSI ;
  5927. SI ( EXISTE MA1 ) ;
  5928. GEO1 = MA1 ;
  5929. FINSI ;
  5930. SI ( EXISTE MA2 ) ;
  5931. IDEUX = 1 ;
  5932. GEO2 = MA2 ;
  5933. FINSI ;
  5934. SI ( EGA IDEUX 1 ) ;
  5935. GEO = GEO1 ET GEO2 ; SINON ;
  5936. GEO = GEO1 ;
  5937. FINSI ;
  5938. *
  5939. *------------------------------
  5940. * ON RECUPERE LA DIRECTION
  5941. *------------------------------
  5942. SI ( EGA IDIR 1 ) ;
  5943. IDIR = 1 ;
  5944. SI ( EGA SSDIM 2 ) ;
  5945. V1X V1Y = COOR V1 ;
  5946. V2 = V1Y ( 0 - V1X ) ;
  5947. SINON ;
  5948. V1X V1Y V1Z = COOR V1 ;
  5949. V2X = 0. - V1Y ;
  5950. V2Y = V1X ;
  5951. V2Z = 0. ;
  5952. V2 = V2X V2Y V2Z ;
  5953. V2NOR = NORM V2 ;
  5954. SI ( EGA V2NOR 0. ) ;
  5955. V2 = 0. ( 0. - V1Z ) V1Y ;
  5956. FINSI ;
  5957. V3 = PVECT V1 V2 ;
  5958. FINSI ;
  5959. SINON ;
  5960. SI ( EGA DDL UX ) ;
  5961. SI ( EGA SSDIM 2 ) ;
  5962. V1 = 1 0 ;
  5963. V2 = 0 -1 ;
  5964. SINON ;
  5965. V1 = 1 0 0 ;
  5966. V2 = 0 1 0 ;
  5967. V3 = 0 0 1 ;
  5968. FINSI ;
  5969. FINSI ;
  5970. SI ( EGA DDL UY ) ;
  5971. SI ( EGA SSDIM 2 ) ;
  5972. V1 = 0 1 ;
  5973. V2 = 1 0 ;
  5974. SINON ;
  5975. V1 = 0 1 0 ;
  5976. V2 = 0 0 1;
  5977. V3 = 1 0 0 ;
  5978. FINSI ;
  5979. FINSI ;
  5980. SI ( EGA DDL UR ) ;
  5981. V1 = 1 0 ;
  5982. V2 = 0 1 ;
  5983. FINSI ;
  5984. SI ( EGA DDL UZ ) ;
  5985. SI ( EGA SSDIM 2 ) ;
  5986. V1 = 0 1 ;
  5987. V2 = 1 0 ;
  5988. SINON ;
  5989. V1 = 0 0 1 ;
  5990. V2 = 1 0 0;
  5991. V3 = 0 1 0 ;
  5992. FINSI ;
  5993. FINSI ;
  5994. FINSI ;
  5995. *-----------------------
  5996. * ON RECUPERE LE JEU
  5997. *-----------------------
  5998. IJEU = 0 ;
  5999. SI ( EXISTE MJEU ) ;
  6000. IJEU = 1 ;
  6001. SI ( EXISTE VVAL ) ;
  6002. VJEU = VVAL ;
  6003. FINSI ;
  6004. SI ( EXISTE VCHP ) ;
  6005. VJEU = VCHP ;
  6006. FINSI ;
  6007. FINSI ;
  6008. *--------------------------
  6009. * ON CREE LES BLOCAGES
  6010. *--------------------------
  6011. *
  6012. SI ( EGA IDEUX 0 ) ;
  6013. BLC = BLOQUE MOMIN DEPL DIRECTION V1 GEO1 ;
  6014. BLT = BLOQUE FROT DEPL DIRECTION V2 GEO1 ;
  6015. SI ( EGA SSDIM 3 ) ;
  6016. BLT = BLT ET ( BLOQUE FROT DEPL DIRECTION V3 GEO1 ) ;
  6017. FINSI ;
  6018. SINON ;
  6019. BLC = RELA MOMIN DEPL DIREC V1 GEO1 - DEPL DIREC V1 GEO2 ;
  6020. BLT = RELA FROT DEPL DIREC V2 GEO1 - DEPL DIREC V2 GEO2 ;
  6021. SI ( EGA SSDIM 3 ) ;
  6022. BLT = BLT ET ( RELA FROT DEPL DIREC V3 GEO1 - DEPL DIREC V3 GEO2 ) ;
  6023. FINSI ;
  6024. FINSI ;
  6025. *BLOCAG = BLC ET BLT ;
  6026. *-------------------------------------------
  6027. * ON CALCULE LES FORCES AU SECOND MEMBRE
  6028. *-------------------------------------------
  6029. SI ( EGA IJEU 1 ) ;
  6030. SI ( EGA MOMIN MAXI ) ;
  6031. FAC = 1.;
  6032. SINON ;
  6033. FAC = -1. ;
  6034. FINSI ;
  6035. FFF = DEPI BLC ( FAC * VJEU ) ;
  6036. SINON ;
  6037. FFF = MANU CHPO GEO 1 FLX 0. ;
  6038. FINSI ;
  6039. *---------------------------------------------
  6040. * ON CALCULE LES COEFFICIENTS DE FROTTEMENT
  6041. *---------------------------------------------
  6042. GEOT = EXTR BLT MAIL MULT ;
  6043. COEF = MANU CHPO GEOT 1 MFRO ZFRO ;
  6044. *----------------------------------------------------------------------
  6045. * SORTIE DE LA PROCEDURE
  6046. *----------------------------------------------------------------------
  6047. FINPROC BLC BLT FFF COEF ;
  6048. * 1 2 3 4 5 6 7*
  6049. *123456789012345678901234567890123456789012345678901234567890123456789012
  6050. * *
  6051. * *
  6052. * *
  6053. DEBPROC CONTRAPH LIGN_1*MAILLAGE INSTEVOL*FLOTTANT MOD1*MMODEL TAB1*TABLE SM1/EVOLUTION SM2/EVOLUTION VAL1/FLOTTANT;
  6054.  
  6055. MESS '-----------------------------------> entree dans CONTRAPH ' ;
  6056.  
  6057. DIM1 = VALEUR DIME ;
  6058. * test sur la dimension
  6059. SI (EGA DIM1 2) ;
  6060. MESS ' attention au SMZZ en 2D' ;
  6061. SINON ;
  6062. MESS ' !!! ATTENTION !!! en 3 D ' ;
  6063. MESS ' utilisation a vos risques et perils a cause du fonctionement incertain de PROI ' ;
  6064. MESS ' la remarque est sans objet si LIGN_1 appartient au maillage ';
  6065. FINSI;
  6066.  
  6067.  
  6068. SI (NON (EXISTE TAB1 RESUCONT)) ;
  6069. MESS ' TAB1 NE CONTIENT PAS DE CONTRAINTES ' ;
  6070. MESS ' SORTIE DE CONTRAPH ' ;
  6071. QUITTER CONTRAPH ;
  6072. FINSI ;
  6073.  
  6074. * test sur la dimension de LIGN_1*MAILLAGE : a faire
  6075.  
  6076. LCONFON = FAUX ;
  6077. MAIL_1 = MOD1 EXTR 'MAIL' ;
  6078. N_1 = NBNO MAIL_1 ;
  6079. N_2 = NBNO (MAIL_1 ET LIGN_1 ) ;
  6080.  
  6081. SI ( EGA N_1 N_2 ) ;
  6082. LCONFON = VRAI ;
  6083. FINSI ;
  6084.  
  6085. SI (NON(EXISTE TAB1 TETMAT)) ;
  6086. MESS ' TAB1 NE CONTIENT PAS DE TETMAT ' ;
  6087. MESS ' SORTIE DE CONTRAPH ' ;
  6088. QUITTER CONTRAPH ;
  6089. FINSI ;
  6090.  
  6091. SI (NON(EXISTE (TAB1.TETMAT) MOD1)) ;
  6092. MESS ' TAB1.TETMAT NE CONTIENT PAS DE MODELE ' ;
  6093. MESS ' SORTIE DE CONTRAPH ' ;
  6094. QUITTER CONTRAPH ;
  6095. FINSI ;
  6096.  
  6097. SI (NON(EXISTE (TAB1.TETMAT.MOD1) SIGY)) ;
  6098. MESS ' LE MATERIAU DEMANDE N EST PAS PLASTIQUE ' ;
  6099. MESS ' SORTIE DE CONTRAPH ' ;
  6100. QUITTER CONTRAPH ;
  6101. FINSI ;
  6102.  
  6103. L1TITR = CHAIN 'DEPOUILLEMENT LE LONG DE LA LIGNE A' INSTEVOL ;
  6104. TITR L1TITR ;
  6105.  
  6106. LIMELAS1 = VARI TAB1.CHPOTHETA.INSTEVOL TAB1.TETMAT.MOD1.'SIGY' ;
  6107.  
  6108. SI (EXISTE SM1) ;
  6109. LIMSM1 = VARI TAB1.CHPOTHETA.INSTEVOL SM1 ;
  6110. FINSI ;
  6111. SI (EXISTE SM2) ;
  6112. LIMSM2 = VARI TAB1.CHPOTHETA.INSTEVOL SM2 ;
  6113. FINSI ;
  6114. VMIS1 = VMIS MOD1 TAB1.RESUCONT. INSTEVOL ;
  6115.  
  6116. CHEP4 = EXCO TAB1.RESUVARI.INSTEVOL EPSE ;
  6117. CHEP3 = REDU CHEP4 MOD1 ;
  6118. CHEP2 = (CHAN NOEUD CHEP3 MOD1 );
  6119.  
  6120. SI LCONFON ;
  6121. CHVM1 = CHAN 'CHPO' MOD1 (CHAN NOEUD MOD1 VMIS1) ;
  6122. LIMELAS2 = LIMELAS1 ;
  6123. CHEP1 = CHAN 'CHPO' MOD1 CHEP2 ;
  6124. SI (EXISTE SM1 ) ;
  6125. LIM2SM1 = LIMSM1 ;
  6126. FINSI ;
  6127. SI (EXISTE SM2 ) ;
  6128. LIM2SM2 = LIMSM2 ;
  6129. FINSI ;
  6130. SINON ;
  6131. CHVM1 = PROI LIGN_1 (CHAN NOEUD MOD1 VMIS1) ;
  6132. LIMELAS2 = PROI LIGN_1 (CHAN CHAM LIMELAS1 MOD1 NOEUD) ;
  6133. CHEP1 = PROI LIGN_1 CHEP2 ;
  6134. SI (EXISTE SM1) ;
  6135. LIM2SM1 = PROI LIGN_1 (CHAN CHAM LIMSM1 MOD1 NOEUD) ;
  6136. FINSI ;
  6137. SI (EXISTE SM2) ;
  6138. LIM2SM2 = PROI LIGN_1 (CHAN CHAM LIMSM2 MOD1 NOEUD) ;
  6139. FINSI ;
  6140. FINSI ;
  6141.  
  6142. TAC1 = TABLE ;
  6143. EVVM1 = EVOL ROUG CHPO CHVM1 LIGN_1 ;
  6144. EVEL1 = EVOL BLEU CHPO LIMELAS2 LIGN_1 ;
  6145. * champs dde t le long de la ligne
  6146. TCHAM = CHAN CHAM (TAB1.CHPOTHETA.INSTEVOL) MOD1 NOEUD ;
  6147. PTCH = PROI TCHAM LIGN_1 ;
  6148. EVTE1 = EVOL JAUN CHPO (PTCH * 1.E6) 'T' LIGN_1 ;
  6149. TAC1.1 = CHAI 'MARQ CARR REGU TITR V_MISES ' ;
  6150. TAC1.3 = CHAI 'MARQ LOSA REGU TITR LIM_ELAS' ;
  6151. TAC1.5 = CHAI 'MARQ CROI REGU TITR TEMPERAT' ;
  6152. EV_OTT = EVVM1 ET EVEL1 ET EVTE1 ;
  6153.  
  6154. SI (EXISTE SM1) ;
  6155. EVRU1 = EVOL TURQ CHPO LIM2SM1 LIGN_1 ;
  6156. TAC1.7 = CHAI 'MARQ TRIA REGU TITR SM' ;
  6157. SI (EXISTE SM2) ;
  6158. EVRU2 = EVOL VERT CHPO LIM2SM2 LIGN_1 ;
  6159. TAC1.9 = CHAI 'MARQ TRIB REGU TITR 3SM_ou_RM' ;
  6160. SI (EXISTE VAL1) ;
  6161. EVVA1 = EVOL CHPO VAL1 LIGN_1 ;
  6162. TAC1.11 = CHAI 'MARQ ETOI REGU TITR VALEUR' ;
  6163. EV_OTT = EV_OTT ET EVRU1 ET EVRU2 ET EVVA1 ;
  6164. SINON ;
  6165. EV_OTT = EV_OTT ET EVRU1 ET EVRU2 ;
  6166. FINSI ;
  6167. SINON ;
  6168. SI (EXISTE VAL1) ;
  6169. EVVA1 = EVOL CHPO VAL1 LIGN_1 ;
  6170. TAC1.9 = CHAI 'MARQ ETOI REGU TITR VALEUR' ;
  6171. EV_OTT = EV_OTT ET EVRU1 ET EVVA1 ;
  6172. FINSI ;
  6173. *tc ajout du finsi cidessous au pif
  6174. FINSI; ;
  6175. SINON ;
  6176. SI (EXISTE VAL1 ) ;
  6177. EVVA1 = EVOL CHPO VAL1 LIGN_1 ;
  6178. TAC1.7 = CHAI 'MARQ ETOI REGU TITR VALEUR' ;
  6179. EV_OTT = EV_OTT ET EVVA1 ;
  6180. FINSI ;
  6181. FINSI ;
  6182.  
  6183. DESS EV_OTT LEGE MIMA TAC1 ;
  6184.  
  6185. MESS '-----------------------------------> sortie de CONTRAPH ' ;
  6186.  
  6187. FINPROC ;
  6188. **** @COUTOR1
  6189. *****************************************************************
  6190. * PROCEDURE @COUTOR1 :
  6191. *****************************************************************
  6192.  
  6193. DEBPROC @COUTOR1 IEL*MAILLAGE CHT*CHPOINT CHN*CHPOINT CHB*CHPOINT ;
  6194. PI = 3.14159 ;
  6195. P2 = IEL POIN INITIAL ;
  6196. P3 = IEL POIN FINAL ;
  6197. DIMGEO1 = VALEUR DIME ;
  6198. SI (DIMGEO1 > 2);
  6199. NXI2 = EXTR CHN NX P2 ;
  6200. NYI2 = EXTR CHN NY P2 ;
  6201. NZI2 = EXTR CHN NZ P2 ;
  6202. VN2 = NXI2 NYI2 NZI2 ;
  6203. TXI2 = EXTR CHT TX P2 ;
  6204. TYI2 = EXTR CHT TY P2 ;
  6205. TZI2 = EXTR CHT TZ P2 ;
  6206. VT2 = TXI2 TYI2 TZI2 ;
  6207. BXI2 = EXTR CHB BX P2 ;
  6208. BYI2 = EXTR CHB BY P2 ;
  6209. BZI2 = EXTR CHB BZ P2 ;
  6210. VB2 = BXI2 BYI2 BZI2 ;
  6211. NXI3 = EXTR CHN NX P3 ;
  6212. NYI3 = EXTR CHN NY P3 ;
  6213. NZI3 = EXTR CHN NZ P3 ;
  6214. VN3 = NXI3 NYI3 NZI3 ;
  6215. TXI3 = EXTR CHT TX P3 ;
  6216. TYI3 = EXTR CHT TY P3 ;
  6217. TZI3 = EXTR CHT TZ P3 ;
  6218. VT3 = TXI3 TYI3 TZI3 ;
  6219. BXI3 = EXTR CHB BX P3 ;
  6220. BYI3 = EXTR CHB BY P3 ;
  6221. BZI3 = EXTR CHB BZ P3 ;
  6222. VB3 = BXI3 BYI3 BZI3 ;
  6223. XR = VT3 PSCA VT2 ;
  6224. YR = VT3 PSCA VN2 ;
  6225. * MESS 'XR =' XR 'YR =' YR ;
  6226. ALPHA = ATG YR XR ;
  6227. * MESS 'ALPHA =' ALPHA ;
  6228. DS2 = NORM (MOIN P2 P3) ;
  6229. RR = (ALPHA*PI/180.)/DS2 ;
  6230. SI (RR NEG 0.) ;
  6231. R = 1./RR ;
  6232. SINON ;
  6233. R = 1.E99 ;
  6234. FINSI ;
  6235. * MESS 'R =' R ;
  6236. XT = VB2 PSCA VB3 ;
  6237. YT = VB2 PSCA VN3 ;
  6238. * MESS 'XT =' XT 'YT =' YT ;
  6239. BETA = ATG YT XT ;
  6240. * MESS 'BETA =' BETA ;
  6241. TT = -1*(BETA*PI/180.)/DS2 ;
  6242. SI (TT NEG 0.) ;
  6243. T = 1./TT ;
  6244. SINON ;
  6245. T = 1.E99 ;
  6246. FINSI ;
  6247. * MESS 'T =' T ;
  6248.  
  6249. SINON;
  6250. NXI2 = EXTR CHN NX P2 ;
  6251. NYI2 = EXTR CHN NY P2 ;
  6252. VN2 = NXI2 NYI2 ;
  6253. TXI2 = EXTR CHT TX P2 ;
  6254. TYI2 = EXTR CHT TY P2 ;
  6255. VT2 = TXI2 TYI2 ;
  6256. BXI2 = EXTR CHB BX P2 ;
  6257. BYI2 = EXTR CHB BY P2 ;
  6258. VB2 = BXI2 BYI2 ;
  6259. NXI3 = EXTR CHN NX P3 ;
  6260. NYI3 = EXTR CHN NY P3 ;
  6261. VN3 = NXI3 NYI3 ;
  6262. TXI3 = EXTR CHT TX P3 ;
  6263. TYI3 = EXTR CHT TY P3 ;
  6264. VT3 = TXI3 TYI3 ;
  6265. BXI3 = EXTR CHB BX P3 ;
  6266. BYI3 = EXTR CHB BY P3 ;
  6267. VB3 = BXI3 BYI3 ;
  6268. XR = VT3 PSCA VT2 ;
  6269. YR = VT3 PSCA VN2 ;
  6270. * MESS 'XR =' XR 'YR =' YR ;
  6271. ALPHA = ATG YR XR ;
  6272. * MESS 'ALPHA =' ALPHA ;
  6273. DS2 = NORM (MOIN P2 P3) ;
  6274. RR = (ALPHA*PI/180.)/DS2 ;
  6275. SI (RR NEG 0.) ;
  6276. R = 1./RR ;
  6277. SINON ;
  6278. R = 1.E99 ;
  6279. FINSI ;
  6280. * MESS 'R =' R ;
  6281. BETA = 0.;
  6282. T = 0.;
  6283. FINSI;
  6284. FINPROC DS2 R T ALPHA BETA ;
  6285. **** @COUTOR2
  6286. *****************************************************************
  6287. * PROCEDURE @COUTOR2 : CREATION DE 2 CHAMPS PAR ELEMENTS R ET T
  6288. *****************************************************************
  6289. DEBPROC @COUTOR2 GEOFRE*MAILLAGE CHT*CHPOINT CHN*CHPOINT CHB*CHPOINT ;
  6290.  
  6291. NBELGEO = NBEL GEOFRE;
  6292. DIMGEO1 = VALEUR DIME ;
  6293. NBEL1 = 0;
  6294. REPETER BOUCEL NBELGEO;
  6295. NBEL1 = NBEL1 + 1;
  6296. ELEMCOUR = GEOFRE ELEM NBEL1;
  6297. PTINIT = ELEMCOUR POIN INITIAL;
  6298. PTFIN = ELEMCOUR POIN FINAL;
  6299. SI (DIMGEO1 > 2);
  6300. NXI2 = EXTR CHN NX PTINIT ;
  6301. NYI2 = EXTR CHN NY PTINIT ;
  6302. NZI2 = EXTR CHN NZ PTINIT ;
  6303. VN2 = NXI2 NYI2 NZI2 ;
  6304. TXI2 = EXTR CHT TX PTINIT ;
  6305. TYI2 = EXTR CHT TY PTINIT ;
  6306. TZI2 = EXTR CHT TZ PTINIT ;
  6307. VT2 = TXI2 TYI2 TZI2 ;
  6308. BXI2 = EXTR CHB BX PTINIT ;
  6309. BYI2 = EXTR CHB BY PTINIT ;
  6310. BZI2 = EXTR CHB BZ PTINIT ;
  6311. VB2 = BXI2 BYI2 BZI2 ;
  6312. NXI3 = EXTR CHN NX PTFIN ;
  6313. NYI3 = EXTR CHN NY PTFIN ;
  6314. NZI3 = EXTR CHN NZ PTFIN ;
  6315. VN3 = NXI3 NYI3 NZI3 ;
  6316. TXI3 = EXTR CHT TX PTFIN ;
  6317. TYI3 = EXTR CHT TY PTFIN ;
  6318. TZI3 = EXTR CHT TZ PTFIN ;
  6319. VT3 = TXI3 TYI3 TZI3 ;
  6320. BXI3 = EXTR CHB BX PTFIN ;
  6321. BYI3 = EXTR CHB BY PTFIN ;
  6322. BZI3 = EXTR CHB BZ PTFIN ;
  6323. VB3 = BXI3 BYI3 BZI3 ;
  6324. XR = VT3 PSCA VT2 ;
  6325. YR = VT3 PSCA VN2 ;
  6326. * MESS 'XR =' XR 'YR =' YR ;
  6327. ALPHA = ATG YR XR ;
  6328. * MESS 'ALPHA =' ALPHA ;
  6329. DS2 = NORM (MOIN PTINIT PTFIN) ;
  6330. RR = (ALPHA*PI/180.)/DS2 ;
  6331. SI (RR NEG 0.) ;
  6332. R = 1./RR ;
  6333. SINON ;
  6334. R = 1.E99 ;
  6335. FINSI ;
  6336. * MESS 'R =' R ;
  6337. XT = VB2 PSCA VB3 ;
  6338. YT = VB2 PSCA VN3 ;
  6339. * MESS 'XT =' XT 'YT =' YT ;
  6340. BETA = ATG YT XT ;
  6341. * MESS 'BETA =' BETA ;
  6342. TT = -1*(BETA*PI/180.)/DS2 ;
  6343. SI (TT NEG 0.) ;
  6344. T = 1./TT ;
  6345. SINON ;
  6346. T = 1.E99 ;
  6347. FINSI ;
  6348. * MESS 'T =' T ;
  6349.  
  6350. SINON;
  6351. NXI2 = EXTR CHN NX PTINIT ;
  6352. NYI2 = EXTR CHN NY PTINIT ;
  6353. VN2 = NXI2 NYI2 ;
  6354. TXI2 = EXTR CHT TX PTINIT ;
  6355. TYI2 = EXTR CHT TY PTINIT ;
  6356. VT2 = TXI2 TYI2 ;
  6357. BXI2 = EXTR CHB BX PTINIT ;
  6358. BYI2 = EXTR CHB BY PTINIT ;
  6359. VB2 = BXI2 BYI2 ;
  6360. NXI3 = EXTR CHN NX PTFIN ;
  6361. NYI3 = EXTR CHN NY PTFIN ;
  6362. VN3 = NXI3 NYI3 ;
  6363. TXI3 = EXTR CHT TX PTFIN ;
  6364. TYI3 = EXTR CHT TY PTFIN ;
  6365. VT3 = TXI3 TYI3 ;
  6366. BXI3 = EXTR CHB BX PTFIN ;
  6367. BYI3 = EXTR CHB BY PTFIN ;
  6368. VB3 = BXI3 BYI3 ;
  6369. XR = VT3 PSCA VT2 ;
  6370. YR = VT3 PSCA VN2 ;
  6371. * MESS 'XR =' XR 'YR =' YR ;
  6372. ALPHA = ATG YR XR ;
  6373. * MESS 'ALPHA =' ALPHA ;
  6374. DS2 = NORM (MOIN PTINIT PTFIN) ;
  6375. RR = (ALPHA*PI/180.)/DS2 ;
  6376. SI (RR NEG 0.) ;
  6377. R = 1./RR ;
  6378. SINON ;
  6379. R = 1.E99 ;
  6380. FINSI ;
  6381. * MESS 'R =' R ;
  6382. BETA = 0.;
  6383. T = 0.;
  6384. FINSI;
  6385. SI (EGA NBEL1 1) ;
  6386. CHCOU = PROG R ;
  6387. CHTOR = PROG T ;
  6388. SINON ;
  6389. CHCOU =CHCOU ET (PROG R) ;
  6390. CHTOR = CHTOR ET ( PROG T ) ;
  6391. FINSI;
  6392. FIN BOUCEL;
  6393. CHRT = MANU CHML GEOFRE 'R' CHCOU 'T' CHTOR TYPE GRAVITE ;
  6394. FINPROC CHRT;
  6395. **** @CRCACY
  6396. DEBPROC @CRCACY XG*CHPOINT YG*CHPOINT ZG*CHPOINT ;
  6397. *
  6398. ***************************************************************
  6399. * NICOLAS CURT 30032000Procedure de changement de repere.
  6400. * cartesiennes => cylindriques
  6401. *
  6402. ***************************************************************
  6403. *
  6404. PHI = ATG YG XG ;
  6405.  
  6406. RHO = (XG*XG + (YG*YG))**0.5 ;
  6407. *
  6408. FINPROC RHO PHI ZG ;
  6409.  
  6410.  
  6411. **** @CRGMC
  6412. DEBPROC @CRGMC XG*CHPOINT YG*CHPOINT ZG*CHPOINT TAB1*TABLE ;
  6413. *
  6414. *******************************************************************
  6415. * Procedure de changement de repere. On passe du repere cartesien *
  6416. * global de la machine defini par son origine au centre du tore, *
  6417. * l'axe du tore dirige suivant Z et l'axe X situe dans le plan *
  6418. * median entre deux bobines au repere cartesien du maillage. *
  6419. * Trois cas sont etudies : 3D, 2D en coupe Phi constant et 2D en *
  6420. * coupe Theta constant. Alain MOAL (Decembre 1995-Janvier 1996) *
  6421. *******************************************************************
  6422. *
  6423. *--------------- VARIABLES D'ENTREE :
  6424. SI ((VALEUR DIME) EGA 2) ;
  6425. IPLAN = TAB1.<PLAN ;
  6426. SI (EGA IPLAN 'PHICONS') ;
  6427. CT0 = TAB1.<CENTRE_TORE ;
  6428. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  6429. P1 = TAB1.<POINT_SUR_OBJET ;
  6430. FINSI ;
  6431. SI (EGA IPLAN 'THECONS') ;
  6432. THETA0 = TAB1.<THETA0 ;
  6433. CP = TAB1.CENTRE_PLASMA ;
  6434. RP = TAB1.<RP ;
  6435. HP = TAB1.<HP ;
  6436. FINSI ;
  6437. SINON ;
  6438. CT0 = TAB1.<CENTRE_TORE ;
  6439. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  6440. P1 = TAB1.<POINT_SUR_OBJET ;
  6441. FINSI ;
  6442. ANGPHI0 = TAB1.<ANG_PHI0 ;
  6443. *------------------------------------
  6444. *
  6445. DIM0 = VALEUR DIME ;
  6446. SI (DIM0 EGA 2) ;
  6447. FINSI ;
  6448. *
  6449. SI (((DIM0 EGA 2) ET (EGA IPLAN 'PHICONS')) OU (DIM0 EGA 3)) ;
  6450. * ---- en 3D ou en 2D pour la section Phi constant
  6451. X0 Y0 Z0 = COOR CT0 ;
  6452. X1 Y1 Z1 = COOR CT1 ;
  6453. XP1 YP1 ZP1 = COOR P1 ;
  6454. *
  6455. * ---- Calcul des coordonnees du point P0, projection du point P1 de
  6456. * ---- l'objet dans le plan orthogonal a l'axe du tore en CT0.
  6457. A = X1 - X0 ;
  6458. B = Y1 - Y0 ;
  6459. C = Z1 - Z0 ;
  6460. *
  6461. SI (A EGA 0.) ;
  6462. SI (B EGA 0.) ;
  6463. XP0 = XP1 ;
  6464. YP0 = YP1 ;
  6465. ZP0 = Z0 ;
  6466. FINSI ;
  6467. SI (C EGA 0.) ;
  6468. XP0 = XP1 ;
  6469. YP0 = Y0 ;
  6470. ZP0 = ZP1 ;
  6471. FINSI ;
  6472. SI ((B NEG 0.) ET (C NEG 0.)) ;
  6473. XP0 = XP1 ;
  6474. YP0 = (-1.*B*C*ZP1 + (C*C*YP1) + (B*B*Y0) + (B*C*Z0)) /(B*B + (C*C)) ;
  6475. ZP0 = (B*ZP1 - (C*YP1) + (C*(Y0+Z0)))/(B+C);
  6476. FINSI ;
  6477. SINON ;
  6478. AUX1 = A / (A*A + (B*B) + (C*C)) ;
  6479. AUX2 = (B*B + (C*C)) / A ;
  6480. XP0 = AUX1 * (A*X0 + (B*Y0) + (C*Z0) + (AUX2*XP1) - (B*YP1) - (C*ZP1)) ;
  6481. YP0 = B * (XP0 - XP1) / A + YP1 ;
  6482. ZP0 = C * (XP0 - XP1) / A + ZP1 ;
  6483. FINSI ;
  6484. *
  6485. P0 = XP0 YP0 ZP0 ;
  6486. *
  6487. * ---- Rotation de la ligne (CT0,P0) pour l'aligner sur l'axe X
  6488. * ---- du repere global
  6489. LIG0 = CT0 D 1 P0 ;
  6490. LIG1 = LIG0 TOUR (-1.*ANGPHI0) CT0 CT1 ;
  6491. *
  6492. * ---- Calcul des 3 vecteurs unitaires du repere global
  6493. P0X = LIG1 POIN FINAL ;
  6494. DIR1 = P0X MOIN CT0 ;
  6495. VEC1 = DIR1 / (NORM DIR1) ;
  6496. DIR3 = CT1 MOIN CT0 ;
  6497. VEC3 = DIR3 / (NORM DIR3) ;
  6498. VEC2 = VEC3 PVEC VEC1 ;
  6499. *
  6500. * ---- Changement de repere
  6501. A1 B1 C1 = COOR VEC1 ;
  6502. A2 B2 C2 = COOR VEC2 ;
  6503. A3 B3 C3 = COOR VEC3 ;
  6504. *
  6505. XM1 = (A1 * XG) + (A2 * YG) + (A3 * ZG) ;
  6506. YM1 = (B1 * XG) + (B2 * YG) + (B3 * ZG) ;
  6507. ZM1 = (C1 * XG) + (C2 * YG) + (C3 * ZG) ;
  6508. *
  6509. XM = XM1 + X0 ;
  6510. YM = YM1 + Y0 ;
  6511. ZM = ZM1 + Z0 ;
  6512. *
  6513. SINON ;
  6514. *
  6515. * ---- en 2D pour une section a Theta constant
  6516. XCP YCP ZCP = COOR CP ;
  6517. NORM_CP = (XCP*XCP + (YCP*YCP) + (ZCP*ZCP))**0.5 ;
  6518. ANG1 = ATG XCP YCP ;
  6519. *
  6520. * ---- Rotation de (90 + ANGPHI0) par rapport a l'axe Z
  6521. X1 = -1. * XG * (SIN ANGPHI0) + (YG * (COS ANGPHI0)) ;
  6522. Y1 = -1. * XG * (COS ANGPHI0) - (YG * (SIN ANGPHI0)) ;
  6523. Z1 = ZG ;
  6524. *
  6525. * ---- Changement d'origine vers le centre du plasma
  6526. X2 = X1 ;
  6527. Y2 = Y1 + RP + (NORM_CP * (COS THETA0)) ;
  6528. Z2 = Z1 - HP - (NORM_CP * (SIN THETA0)) ;
  6529. *
  6530. * ---- Rotation de -THETA0 par rapport a l'axe X
  6531. X3 = X2 ;
  6532. Y3 = Y2 * (COS THETA0) - (Z2 * (SIN THETA0)) ;
  6533. Z3 = Y2 * (SIN THETA0) + (Z2 * (COS THETA0)) ;
  6534. *
  6535. * ---- Rotation de ANG1 par rapport a l'axe Z
  6536. XM = X3 * (COS ANG1) + (Y3 * (SIN ANG1)) ;
  6537. YM = -1. * X3 * (SIN ANG1) + (Y3 * (COS ANG1)) ;
  6538. ZM = Z3 ;
  6539. *
  6540. FINSI ;
  6541. *
  6542. SI (DIM0 EGA 2) ;
  6543. FINSI ;
  6544. *
  6545. FINPROC XM YM ZM ;
  6546.  
  6547. **** @CRGTC
  6548. DEBPROC @CRGTC XG*CHPOINT YG*CHPOINT ZG*CHPOINT R*FLOTTANT H*FLOTTANT ;
  6549. *
  6550. ***************************************************************
  6551. * Procedure de changement de repere. On passe des coordonnees *
  6552. * cartesiennes dans le repere global de la machine defini par *
  6553. * son origine au centre du tore, l'axe du tore dirige suivant *
  6554. * Z et l'axe X situe dans le plan median entre deux bobines *
  6555. * aux coordonnees pseudo-toroidales dans un repere defini par *
  6556. * son grand rayon R et la hauteur H de son centre par rapport *
  6557. * au plan equatorial. Alain MOAL (decembre 1995) *
  6558. ***************************************************************
  6559. *mess ' ---> calling @CRGTC';
  6560. *
  6561. PHI = ATG YG XG ;
  6562. *
  6563. *
  6564. *---- Rotation de Phi par rapport a l'axe Z
  6565. *
  6566. X1 = (COS PHI) * XG + ((SIN PHI) * YG) ;
  6567. Y1 = -1. * (SIN PHI) * XG + ((COS PHI) * YG) ;
  6568. Z1 = ZG ;
  6569. *
  6570. *---- Changement d'origine vers le centre du nouveau repere
  6571. X2 = X1 - R ;
  6572. Y2 = Y1 ;
  6573. Z2 = Z1 - H ;
  6574. *
  6575. *---- Calcul de Theta et Rho
  6576. *
  6577. THETA = ATG Z2 X2 ;
  6578. RHO = (X2*X2 + (Z2*Z2))**0.5 ;
  6579. *mess ' ---> exiting @CRGTC';
  6580. FINPROC RHO THETA PHI ;
  6581. **** @CRIT
  6582. DEBPROC @CRIT TAB1*TABLE;
  6583.  
  6584. MESS '---------------------------------> calling @CRIT';
  6585. MESS ' Calcul du critere d interception par le code';
  6586. *
  6587. * ========= PARAMETRES D'ENTREE
  6588. MAIL2 = TAB1.<S_OMBRANT;
  6589. ALPHA = TAB1.<INCIDENCE_MAXIMALE ;
  6590. PASB0 = TAB1.<PAS_AVEC_TEST ;
  6591.  
  6592.  
  6593. * CALCUL DES PARAMETRES GEOMETRIQUES ENTRANT DANS *
  6594. * LE CALCUL DE DELIM *
  6595.  
  6596. * ---- CAS 3D
  6597. SI ((VALEUR DIME) EGA 3) ;
  6598. C2MAX = 0. ;
  6599. LMOT = MAIL2 ELEM 'TYPE' ;
  6600. typ = table ;
  6601. ntyp = dime LMOT ;
  6602. bootri = faux ;
  6603. booqua = faux ;
  6604. repeter bouty ntyp ;
  6605. i = &bouty ;
  6606. typ.i = extr LMOT i ;
  6607. si (ega typ.i tri3);bootri = vrai; finsi ;
  6608. si (ega typ.i qua4);booqua = vrai; finsi ;
  6609. fin bouty ;
  6610.  
  6611.  
  6612.  
  6613. * ---- BOUCLE LES MAILLES TRIANGULAIRES *
  6614. si bootri ;
  6615. nbtri = nbel (MAIL2 elem tri3) ;
  6616. repeter boutri nbtri ;
  6617. i = &boutri ;
  6618. eli = MAIL2 elem tri3 i ;
  6619. eli = chan eli poi1 ;
  6620. * ---- CALCUL DES DISTANCES A UN DES SOMMETS DE LA MAILLE *
  6621. nbmai = nbno eli ;
  6622. pt1 = elem eli point 1 ;
  6623. pt2 = elem eli point 2 ;
  6624. pt3 = elem eli point 3 ;
  6625. d1_2 = NORM (MOIN PT1 PT2) ;
  6626. d1_3 = NORM (MOIN PT1 PT3) ;
  6627. d3_2 = NORM (MOIN PT3 PT2) ;
  6628. lid = prog d1_2 d1_3 d3_2 ;
  6629. C2 = MAXI lid ;
  6630. C1 = MINI lid ;
  6631.  
  6632. * --- ON CONSIDERE LA MAILLE LA PLUS GRANDE
  6633. SI (C2 > C2MAX) ;
  6634. C2MAX = C2 ;
  6635. C1CO = C1 ;
  6636. FINSI ;
  6637. fin boutri ;
  6638. finsi ;
  6639.  
  6640.  
  6641.  
  6642. * ---- BOUCLE LES MAILLES QUADRANGULAIRES *
  6643. si booqua ;
  6644. nbqua = nbel (MAIL2 elem qua4) ;
  6645.  
  6646. repeter bouqua nbqua ;
  6647. i = &bouqua ;
  6648. eli = MAIL2 elem qua4 i ;
  6649. eli = chan eli poi1 ;
  6650. * ---- CALCUL DES DISTANCES ENTRE LES SOMMETS DE LA MAILLE *
  6651. nbmai = nbel eli ;
  6652. pt1 = elem eli point 1 ;
  6653. pt2 = elem eli point 2 ;
  6654. pt3 = elem eli point 3 ;
  6655. pt4 = elem eli point 4 ;
  6656. d1_2 = NORM (MOIN PT1 PT2) ;
  6657. d2_3 = NORM (MOIN PT3 PT2) ;
  6658. d3_4 = NORM (MOIN PT3 PT4) ;
  6659. d4_1 = NORM (MOIN PT1 PT4) ;
  6660.  
  6661. * ---- CAS DES RECTANGLES *
  6662. SI ((d1_2 ega d3_4) et (d2_3 ega d4_1)) ;
  6663. lid = prog d1_2 d2_3 ;
  6664. c2 = maxi lid ;
  6665. c1 = mini lid ;
  6666.  
  6667.  
  6668. * ---- CAS D'UNE MAILLE NON STRUCTUREE *
  6669. SINON ;
  6670. lid = ORDONNER (prog d1_2 d2_3 d3_4 d4_1) ;
  6671.  
  6672. C2 = EXTR LID 4 ;
  6673. C1 = EXTR LID 3 ;
  6674.  
  6675. FINSI ;
  6676.  
  6677. * --- ON CONSIDERE LA MAILLE LA PLUS GRANDE
  6678. SI (C2 > C2MAX) ;
  6679. C2MAX = C2 ;
  6680. C1CO = C1 ;
  6681. FINSI ;
  6682.  
  6683. fin bouqua ;
  6684. finsi ;
  6685.  
  6686.  
  6687. * --- CALCUL DU CRITERE SELON LA FORMULE TROUVEE
  6688. delim = (((C2MAX**2)+(PASB0**2)+((C1CO*(SIN ALPHA))**2))**0.5) / 2. ;
  6689.  
  6690.  
  6691.  
  6692. * ---- CAS 2D (On considere le pas non projete => majore delim
  6693. SINON ;
  6694. NSEG2 = NBEL (MAIL2 elem SEG2) ;
  6695. CMAX = 0. ;
  6696. REPETER BOUSEG2 NSEG2 ;
  6697. I = &BOUSEG2 ;
  6698. ELI = MAIL2 ELEM SEG2 I ;
  6699. eli = chan eli poi1 ;
  6700. * ---- CALCUL DE LA DISTANCE ENTRE LES EXTREMITES DE LA MAILLE *
  6701. pt1 = elem eli point 1 ;
  6702. pt2 = elem eli point 2 ;
  6703. D1_2 = NORM (MOIN PT1 PT2) ;
  6704. * ---- On stocke la distance la plus grande
  6705. SI (D1_2 > CMAX) ;
  6706. CMAX = D1_2 ;
  6707. FINSI ;
  6708. FIN BOUSEG2 ;
  6709.  
  6710.  
  6711. * --- CALCUL DU CRITERE SELON LA FORMULE TROUVEE
  6712. DELIM = (((PASB0**2)+((CMAX*(SIN ALPHA))**2))**0.5) / 2. ;
  6713. FINSI ;
  6714.  
  6715. MESS '---------------------------------> exiting @CRIT';
  6716. FINPROC delim ;
  6717. **** @CRLMC
  6718. DEBPROC @CRLMC XL*CHPOINT YL*CHPOINT ZL*CHPOINT TAB1*TABLE ;
  6719. *
  6720. *******************************************************************
  6721. * Version amelioree de l'ancien @CRLMC rebaptise @ACRLM *
  6722. * Procedure de changement de repere. On passe du repere cartesien *
  6723. * local de l'objet modelise au repere cartesien du maillage. Le *
  6724. * point de tangence au plasma est l'origine du repere local et *
  6725. * l'axe Y est dirige vers le centre du plasma. En 3D, L'axe X du *
  6726. * repere local est dans la direction toroidale. *
  6727. * en 2D cas PHICONS l'axe Z du repere local est l'axe toroidal *
  6728. * en 2D cas THECONS l'axe x du repere local est l'axe toroidal *
  6729. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  6730. *******************************************************************
  6731. *
  6732. *--------------- VARIABLES D'ENTREE :
  6733. CP = TAB1.CENTRE_PLASMA ;
  6734. PTG = TAB1.PT_TGPLASMA ;
  6735. SI ((VALEUR DIME) EGA 2) ;
  6736. SI (EXISTE TAB1 <PLAN) ;
  6737. IPLAN = TAB1.<PLAN ;
  6738. SINON ;
  6739. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  6740. FINSI ;
  6741. SINON ;
  6742. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  6743. DIR1 = TAB1.<DIR_TOROIDAL ;
  6744. SINON ;
  6745. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  6746. FINSI ;
  6747. FINSI ;
  6748. *------------------------------------
  6749. *
  6750. SI ((VALEUR DIME) EGA 2) ;
  6751. VECT0 = CP MOINS PTG ;
  6752. VX VY = COOR VECT0 ;
  6753. *
  6754. * ---- calcul de l'angle de rotation dans le plan XY
  6755. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  6756. ANG1 = 0. ;
  6757. SINON ;
  6758. ANG1 = -1.* (ATG VX VY) ;
  6759. FINSI ;
  6760. *
  6761. XPTG YPTG = COOR PTG ;
  6762. *
  6763. SI (EGA IPLAN 'PHICONS');
  6764. * ---- Coupe 2D a Phi constant
  6765. XL = ZL ;
  6766. ZL = ZL * 0.;
  6767. * ---- rotation
  6768. XL1 = XL * (COS ANG1) + (YL * (-1.) * (SIN ANG1));
  6769. YL1 = XL * (SIN ANG1) + (YL * (COS ANG1));
  6770. FINSI;
  6771. SI (EGA IPLAN 'THECONS');
  6772. * ---- Coupe 2D a Theta constant
  6773. * ---- rotation
  6774. XL1 = XL * (COS ANG1) + (YL * (-1.) * (SIN ANG1));
  6775. YL1 = XL * (SIN ANG1) + (YL * (COS ANG1));
  6776. FINSI;
  6777. * ---- changement d'origine du repere
  6778. XM = XL1 + XPTG ;
  6779. YM = YL1 + YPTG ;
  6780. ZM = YL1 * 0. ;
  6781. *
  6782. SINON ;
  6783. *
  6784. VEC1 = DIR1 / (NORM DIR1) ;
  6785. DIR2 = CP MOINS PTG ;
  6786. VEC2 = DIR2 / (NORM DIR2) ;
  6787. VEC3 = VEC1 PVEC VEC2 ;
  6788. *
  6789. X0 Y0 Z0 = COOR PTG ;
  6790. A1 B1 C1 = COOR VEC1 ;
  6791. A2 B2 C2 = COOR VEC2 ;
  6792. A3 B3 C3 = COOR VEC3 ;
  6793. *
  6794. XM1 = (A1 * XL) + (A2 * YL) + (A3 * ZL) ;
  6795. YM1 = (B1 * XL) + (B2 * YL) + (B3 * ZL) ;
  6796. ZM1 = (C1 * XL) + (C2 * YL) + (C3 * ZL) ;
  6797. *
  6798. XM = XM1 + X0 ;
  6799. YM = YM1 + Y0 ;
  6800. ZM = ZM1 + Z0 ;
  6801. *
  6802. FINSI ;
  6803. FINPROC XM YM ZM ;
  6804. **** @CRLTC
  6805. DEBPROC @CRLTC TAB1*TABLE XM*CHPOINT YM*CHPOINT ZM*CHPOINT R*FLOTTANT ;
  6806. *
  6807. ***************************************************************
  6808. * Procedure de changement de repere, on passe des *
  6809. * coordonnees cartesiennes dans le repere de local de l'objet *
  6810. * XM YM ZM repere defini par TAB1.<RHO0, TAB1.<THETA0 et *
  6811. * TAB1.<RP aux coordonnees pseudo-toroidales defini par un *
  6812. * grand rayon donne R . Alain MOAL (mai 1995) *
  6813. ***************************************************************
  6814. *
  6815. *--------------- VARIABLES D'ENTREE :
  6816. RHO0 = TAB1.<RHO0 ;
  6817. THETA0 = TAB1.<THETA0 ;
  6818. RP = TAB1.<RP ;
  6819. *------------------------------------
  6820. *
  6821. CT0 = COS THETA0 ;
  6822. ST0 = SIN THETA0 ;
  6823. MST0 = ST0 * -1. ;
  6824. *
  6825. *---- 1) rotation d'angle THETA0 autour de l'axe X
  6826. X1 = XM ;
  6827. Y1 = (YM * CT0) + (ZM * ST0) ;
  6828. Z1 = (YM * MST0) + (ZM * CT0) ;
  6829. *
  6830. *---- 2) changement d'origine vers le centre du tore,
  6831. *---- rotation de 180 degres autour de l'axe Z2 pour
  6832. *---- retrouver le repere global puis calcul de PHI
  6833. X2 = X1 ;
  6834. Y2 = Y1 - (RHO0 * CT0 + RP) ;
  6835. Z2 = Z1 + (RHO0 * ST0) ;
  6836. *
  6837. X2 = X2 * -1. ;
  6838. Y2 = Y2 * -1. ;
  6839. PHI = ATG (X2 * -1.) Y2 ;
  6840. *
  6841. *---- 3) rotation d'angle PHI autour de l'axe Z2
  6842. CPHI = COS PHI ;
  6843. SPHI = SIN PHI ;
  6844. MSPHI = SPHI * -1. ;
  6845. X3 = (X2 * CPHI) + (Y2 * SPHI) ;
  6846. Y3 = (X2 * MSPHI) + (Y2 * CPHI) ;
  6847. Z3 = Z2 ;
  6848. *
  6849. *---- 4) changement d'origine vers le centre du nouveau repere
  6850. X4 = X3 ;
  6851. Y4 = Y3 - R ;
  6852. Z4 = Z3 ;
  6853. *
  6854. *---- calcul de RHO et THETA
  6855. RHO = ((Y4 * Y4) + (Z4 * Z4))**0.5 ;
  6856. THETA = ATG Z4 Y4 ;
  6857. *
  6858. MESS '>>>> @CRLTC : max and min of the angle PHI' ;
  6859. MESS (MAXI PHI) (MINI PHI) ;
  6860. *
  6861. FINPROC RHO THETA PHI ;
  6862. **** @CRMGC
  6863. DEBPROC @CRMGC XM*CHPOINT YM*CHPOINT ZM*CHPOINT TAB1*TABLE ;
  6864. *
  6865. *******************************************************************
  6866. * Procedure de changement de repere. On passe du repere cartesien *
  6867. * quelconque du maillage au repere cartesien global de la machine *
  6868. * defini par son origine au centre du tore, l'axe du tore dirige *
  6869. * suivant Z et l'axe X situe dans le plan median entre deux *
  6870. * bobines. Trois cas sont etudies : 3D, 2D en coupe Phi constant *
  6871. * et 2D en coupe Theta constant. Alain MOAL (Decembre 1995) *
  6872. *******************************************************************
  6873. *
  6874. *--------------- VARIABLES D'ENTREE :
  6875. SI ((VALEUR DIME) EGA 2) ;
  6876. IPLAN = TAB1.<PLAN ;
  6877. SI (EGA IPLAN 'PHICONS') ;
  6878. CT0 = TAB1.<CENTRE_TORE ;
  6879. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  6880. P1 = TAB1.<POINT_SUR_OBJET ;
  6881. FINSI ;
  6882. SI (EGA IPLAN 'THECONS') ;
  6883. THETA0 = TAB1.<THETA0 ;
  6884. CP = TAB1.CENTRE_PLASMA ;
  6885. RP = TAB1.<RP ;
  6886. HP = TAB1.<HP ;
  6887. FINSI ;
  6888. SINON ;
  6889. CT0 = TAB1.<CENTRE_TORE ;
  6890. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  6891. P1 = TAB1.<POINT_SUR_OBJET ;
  6892. FINSI ;
  6893. ANGPHI0 = TAB1.<ANG_PHI0 ;
  6894. *------------------------------------
  6895. *
  6896. DIM0 = VALEUR DIME ;
  6897. SI (DIM0 EGA 2) ;
  6898. FINSI ;
  6899. *
  6900. SI (((DIM0 EGA 2) ET (EGA IPLAN 'PHICONS')) OU (DIM0 EGA 3)) ;
  6901. * ---- en 3D ou en 2D pour la section Phi constant
  6902. X0 Y0 Z0 = COOR CT0 ;
  6903. X1 Y1 Z1 = COOR CT1 ;
  6904. XP1 YP1 ZP1 = COOR P1 ;
  6905. *
  6906. * ---- Calcul des coordonnees du point P0, projection du point P1 de
  6907. * ---- l'objet dans le plan orthogonal a l'axe du tore en CT0.
  6908. A = X1 - X0 ;
  6909. B = Y1 - Y0 ;
  6910. C = Z1 - Z0 ;
  6911. *
  6912. SI (A EGA 0.) ;
  6913. SI (B EGA 0.);
  6914. XP0 = XP1 ;
  6915. YP0 = YP1 ;
  6916. ZP0 = Z0 ;
  6917. FINSI ;
  6918. SI (C EGA 0.) ;
  6919. XP0 = XP1 ;
  6920. YP0 = Y0 ;
  6921. ZP0 = ZP1 ;
  6922. FINSI ;
  6923. SI ((B NEG 0.) ET (C NEG 0.)) ;
  6924. XP0 = XP1 ;
  6925. YP0 = (-1.*B*C*ZP1 + (C*C*YP1) + (B*B*Y0) + (B*C*Z0)) /(B*B + (C*C)) ;
  6926. ZP0 = (B*ZP1 - (C*YP1) + (C*(Y0+Z0)))/(B+C);
  6927. FINSI ;
  6928. SINON ;
  6929. AUX1 = A / (A*A + (B*B) + (C*C)) ;
  6930. AUX2 = (B*B + (C*C)) / A ;
  6931. XP0 = AUX1 * (A*X0 + (B*Y0) + (C*Z0) + (AUX2*XP1) - (B*YP1) - (C*ZP1)) ;
  6932. YP0 = B * (XP0 - XP1) / A + YP1 ;
  6933. ZP0 = C * (XP0 - XP1) / A + ZP1 ;
  6934. FINSI ;
  6935. *
  6936. P0 = XP0 YP0 ZP0 ;
  6937. *
  6938. * ---- Rotation de la ligne (CT0,P0) pour l'aligner sur l'axe X
  6939. * ---- du repere global
  6940. LIG0 = CT0 D 1 P0 ;
  6941. LIG1 = LIG0 TOUR (-1.*ANGPHI0) CT0 CT1 ;
  6942. *
  6943. * ---- Calcul des 3 vecteurs unitaires du repere global
  6944. P0X = LIG1 POIN FINAL ;
  6945. DIR1 = P0X MOIN CT0 ;
  6946. VEC1 = DIR1 / (NORM DIR1) ;
  6947. DIR3 = CT1 MOIN CT0 ;
  6948. VEC3 = DIR3 / (NORM DIR3) ;
  6949. VEC2 = VEC3 PVEC VEC1 ;
  6950. *
  6951. * ---- Changement de repere
  6952. A1 B1 C1 = COOR VEC1 ;
  6953. A2 B2 C2 = COOR VEC2 ;
  6954. A3 B3 C3 = COOR VEC3 ;
  6955. *
  6956. XG1 = XM - X0 ;
  6957. YG1 = YM - Y0 ;
  6958. ZG1 = ZM - Z0 ;
  6959. *
  6960. XG = (A1 * XG1) + (B1 * YG1) + (C1 * ZG1) ;
  6961. YG = (A2 * XG1) + (B2 * YG1) + (C2 * ZG1) ;
  6962. ZG = (A3 * XG1) + (B3 * YG1) + (C3 * ZG1) ;
  6963. *
  6964. SINON ;
  6965. * ---- en 2D pour une section a Theta constant
  6966. *
  6967. XCP YCP ZCP = COOR CP ;
  6968. NORM_CP = (XCP*XCP + (YCP*YCP) + (ZCP*ZCP))**0.5 ;
  6969. ANG1 = ATG XCP YCP ;
  6970. *
  6971. * ---- Rotation de - ANG1 par rapport a l'axe Z
  6972. X1 = XM * (COS ANG1) - (YM * (SIN ANG1)) ;
  6973. Y1 = XM * (SIN ANG1) + (YM * (COS ANG1)) ;
  6974. Z1 = ZM ;
  6975. *
  6976. * ---- Rotation de THETA0 par rapport a l'axe X
  6977. X2 = X1 ;
  6978. Y2 = Y1 * (COS THETA0) + (Z1 * (SIN THETA0)) ;
  6979. Z2 = -1. * Y1 * (SIN THETA0) + (Z1 * (COS THETA0)) ;
  6980. *
  6981. * ---- Changement d'origine vers le centre du tore
  6982. X3 = X2 ;
  6983. Y3 = Y2 - RP - (NORM_CP * (COS THETA0)) ;
  6984. Z3 = Z2 + HP + (NORM_CP * (SIN THETA0)) ;
  6985. *
  6986. * ---- Rotation de -(90 + ANGPHI0) par rapport a l'axe Z
  6987. XG = -1. * X3 * (SIN ANGPHI0) - (Y3 * (COS ANGPHI0)) ;
  6988. YG = X3 * (COS ANGPHI0) - (Y3 * (SIN ANGPHI0)) ;
  6989. ZG = Z3 ;
  6990. *
  6991. FINSI;
  6992. *
  6993. SI (DIM0 EGA 2) ;
  6994. FINSI ;
  6995. *
  6996. FINPROC XG YG ZG ;
  6997.  
  6998.  
  6999.  
  7000. **** @CRMLC
  7001. DEBPROC @CRMLC XM*CHPOINT YM*CHPOINT ZM*CHPOINT TAB1*TABLE ;
  7002. *
  7003. *******************************************************************
  7004. * Version amelioree de l'ancien @CRMLC rebaptise @ACRML *
  7005. * Procedure de changement de repere. On passe du repere cartesien *
  7006. * du maillage au repere cartesien local de l'objet modelise. Le *
  7007. * point de tangence au plasma est l'origine de ce repere et l'axe *
  7008. * l'axe Y final est dirige vers le centre du plasma. *
  7009. * en 3D l'axe x du repere local est donne par la direction *
  7010. * toroidale *
  7011. * en 2D cas PHICONS l'axe Z initial est l'axe toroidal *
  7012. * en 2D cas THECONS l'axe x initial est l'axe toroidal *
  7013. * Jacques SCHLOSSER et Alain MOAL (Decembre 1995) *
  7014. *******************************************************************
  7015. *
  7016. *--------------- VARIABLES D'ENTREE :
  7017. CP = TAB1.CENTRE_PLASMA ;
  7018. PTG = TAB1.PT_TGPLASMA ;
  7019. SI ((VALEUR DIME) EGA 2) ;
  7020. SI (EXISTE TAB1 <PLAN) ;
  7021. IPLAN = TAB1.<PLAN ;
  7022. SINON ;
  7023. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  7024. FINSI ;
  7025. SINON ;
  7026. SI (EXISTE TAB1 <DIR_TOROIDAL) ;
  7027. DIR1 = TAB1.<DIR_TOROIDAL ;
  7028. SINON ;
  7029. ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
  7030. FINSI ;
  7031. FINSI ;
  7032. *------------------------------------
  7033. *
  7034. SI ((VALEUR DIME) EGA 2) ;
  7035. VECT0 = CP MOINS PTG ;
  7036. VX VY = COOR VECT0 ;
  7037. *
  7038. * ---- calcul de l'angle de rotation dans le plan XY
  7039. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  7040. ANG1 = 0. ;
  7041. SINON ;
  7042. ANG1 = -1.* (ATG VX VY) ;
  7043. FINSI ;
  7044. *
  7045. XPTG YPTG = COOR PTG ;
  7046. *
  7047. * ---- changement d'origine du repere
  7048. XM1 = XM - XPTG ;
  7049. YM1 = YM - YPTG ;
  7050. * ---- rotation pour aligner l'axe Y avec VECT0
  7051. SI (EGA IPLAN 'PHICONS');
  7052. * ---- Coupe 2D a Phi constant
  7053. XL = XM1 * (COS ANG1) + (YM1 * (SIN ANG1));
  7054. YL = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1));
  7055. ZL = XM * 0. ;
  7056. *
  7057. ZL = XL ;
  7058. XL = XL * 0.;
  7059. FINSI;
  7060. SI (EGA IPLAN 'THECONS');
  7061. * ---- Coupe 2D a Theta constant
  7062. XL = XM1 * (COS ANG1) + (YM1 * (SIN ANG1));
  7063. YL = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1));
  7064. ZL = XM * 0. ;
  7065. FINSI ;
  7066. *
  7067. SINON ;
  7068. *
  7069. VEC1 = DIR1 / (NORM DIR1) ;
  7070. DIR2 = CP MOINS PTG ;
  7071. VEC2 = DIR2 / (NORM DIR2) ;
  7072. VEC3 = VEC1 PVEC VEC2 ;
  7073. *
  7074. X0 Y0 Z0 = COOR PTG ;
  7075. A1 B1 C1 = COOR VEC1 ;
  7076. A2 B2 C2 = COOR VEC2 ;
  7077. A3 B3 C3 = COOR VEC3 ;
  7078. *
  7079. XM1 = XM - X0 ;
  7080. YM1 = YM - Y0 ;
  7081. ZM1 = ZM - Z0 ;
  7082. *
  7083. XL = (A1 * XM1) + (B1 * YM1) + (C1 * ZM1) ;
  7084. YL = (A2 * XM1) + (B2 * YM1) + (C2 * ZM1) ;
  7085. ZL = (A3 * XM1) + (B3 * YM1) + (C3 * ZM1) ;
  7086. *
  7087. FINSI ;
  7088. FINPROC XL YL ZL ;
  7089.  
  7090.  
  7091. **** @CRTGC
  7092. DEBPROC @CRTGC RHO*CHPOINT THETA*CHPOINT PHI*CHPOINT R*FLOTTANT H*FLOTTANT ;
  7093. *
  7094. *****************************************************************
  7095. * Procedure de changement de repere. On passe des coordonnees *
  7096. * pseudo-toroidales dans un repere defini par son grand rayon R *
  7097. * et la hauteur H de son centre par rapport au plan equatorial *
  7098. * aux coordonnees cartesiennes dans le repere global de la *
  7099. * machine defini par son origine au centre du tore, l'axe du *
  7100. * tore dirige suivant Z et l'axe X situe dans le plan median *
  7101. * entre deux bobines. Alain MOAL (decembre 1995) *
  7102. *****************************************************************
  7103. *
  7104. X2 = RHO * (COS THETA) ;
  7105. Y2 = RHO * 0. ;
  7106. Z2 = RHO * (SIN THETA) ;
  7107. *
  7108. *---- Changement d'origine vers le centre du tore
  7109. X1 = X2 + R ;
  7110. Y1 = Y2 ;
  7111. Z1 = Z2 + H ;
  7112. *
  7113. *---- Rotation de - phi par rapport a l'axe Z
  7114. XG = (COS PHI) * X1 - ((SIN PHI) * Y1) ;
  7115. YG = (SIN PHI) * X1 + ((COS PHI) * Y1) ;
  7116. ZG = Z1 ;
  7117. *
  7118. FINPROC XG YG ZG ;
  7119. **** @CRTLC
  7120. DEBPROC @CRTLC R*FLOTTANT RHO*CHPOINT THETA*CHPOINT PHI*CHPOINT TAB1*TABLE ;
  7121. *
  7122. ***************************************************************
  7123. * Procedure de changement de repere, on passe des coordonnees *
  7124. * pseudo-toroidales centrees sur un grand rayon R aux *
  7125. * coordonnees cartesiennes dans le repere de la structure *
  7126. * modelisee. Alain MOAL (mai 1995) *
  7127. ***************************************************************
  7128. *
  7129. *--------------- VARIABLES D'ENTREE :
  7130. RHO0 = TAB1.<RHO0 ;
  7131. THETA0 = TAB1.<THETA0 ;
  7132. RP = TAB1.<RP ;
  7133. *------------------------------------
  7134. *
  7135. CT0 = COS THETA0 ;
  7136. ST0 = SIN THETA0 ;
  7137. MST0= ST0 * -1. ;
  7138. CPHI = COS PHI ;
  7139. SPHI = SIN PHI ;
  7140. MSPHI = SPHI * -1. ;
  7141. *
  7142. X4 = RHO * 0. ;
  7143. Y4 = RHO * (COS THETA) ;
  7144. Z4 = RHO * (SIN THETA) ;
  7145. *
  7146. *---- 1) changement d'origine vers le centre du tore
  7147. X3 = X4 ;
  7148. Y3 = Y4 + R ;
  7149. Z3 = Z4 ;
  7150. *
  7151. *---- 2) rotation d'angle - PHI autour de l'axe Z3
  7152. * puis rotation de - 180 degres autour de l'axe Z2
  7153. X2 = (X3 * CPHI) + (Y3 * MSPHI) ;
  7154. Y2 = (X3 * SPHI) + (Y3 * CPHI) ;
  7155. Z2 = Z3 ;
  7156. *
  7157. X2 = X2 * -1. ;
  7158. Y2 = Y2 * -1. ;
  7159. *
  7160. *---- 3) changement d'origine vers le centre d'objet
  7161. X1 = X2 ;
  7162. Y1 = Y2 + RP + (RHO0 * CT0) ;
  7163. Z1 = Z2 - (RHO0 * ST0) ;
  7164. *
  7165. *---- 4) rotation d'angle - THETA0 autour de l'axe X1
  7166. XP = X1 ;
  7167. YP = (Y1 * CT0) + (Z1 * MST0) ;
  7168. ZP = (Y1 * ST0) + (Z1 * CT0) ;
  7169. *
  7170. FINPROC XP YP ZP ;
  7171. **** @CRTTC
  7172. DEBPROC @CRTTC R1*FLOTTANT RHO1*CHPOINT THETA1*CHPOINT PHI1*CHPOINT R2*FLOTTANT ;
  7173. *
  7174. ***************************************************************
  7175. * Procedure de changement de repere. On passe d'un repere *
  7176. * pseudo-toroidal defini par son grand rayon R1 a un autre *
  7177. * repere pseudo-toroidal defini par son grand rayon R2. Ces *
  7178. * deux reperes ont la meme orientation toroidale: Phi1 = Phi2 *
  7179. * Alain MOAL (juin 1995) *
  7180. ***************************************************************
  7181. *
  7182. RHO2 = RHO1**2 + ((R1 - R2)**2) ;
  7183. RHO2 = RHO2 + (RHO1*(R1 - R2)*(COS THETA1)*2.) ;
  7184. RHO2 = RHO2**0.5 ;
  7185. *
  7186. AUX1 = RHO1 * (SIN THETA1) ;
  7187. AUX2 = RHO1 * (COS THETA1) - R2 + R1 ;
  7188. THETA2 = ATG AUX1 AUX2 ;
  7189. *
  7190. PHI2 = PHI1 ;
  7191. *
  7192. FINPROC RHO2 THETA2 PHI2 ;
  7193. **** @CSHIFT
  7194. DEBPROC @CSHIFT RHOM*CHPOINT THETAM*CHPOINT PHIM*CHPOINT IMETHOD*ENTIER TAB1*TABLE ;
  7195. *
  7196. ***************************************************************
  7197. * Procedure de calcul des grand et petit rayons du "cercle de *
  7198. * Shafranov" en chaque point M defini dans le repere centre *
  7199. * sur le plasma. On calcule de plus l'angle theta dans le *
  7200. * repere centre sur le cercle calcule. *
  7201. * Deux methodes sont utilisees pour calculer le grand rayon. *
  7202. * Alain MOAL (aout-sept 1995) *
  7203. ***************************************************************
  7204. *
  7205. *--------------- VARIABLES D'ENTREE :
  7206. RP = TAB1.<RP ;
  7207. RHO0 = TAB1.<RHO0 ;
  7208. LAMB = TAB1.<LAMB ;
  7209. *------------------------------------
  7210. *
  7211. SI ((NON (IMETHOD EGA 1)) ET (NON (IMETHOD EGA 2))) ;
  7212. ERRE '>>>> @CSHIFT : YOU MUST CHOOSE THE METHOD 1 OR 2' ;
  7213. FINSI ;
  7214. *
  7215. *---- variables auxiliaires
  7216. A = ((RHOM/RHO0)**-2) + 1. ;
  7217. A = A * (LAMB + 0.5) ;
  7218. A = A + (LOG (RHOM/RHO0)) - 1. ;
  7219. B = LOG (RHOM/RHO0) ;
  7220. B = B - ((((RHOM/RHO0)**-2) - 1.) * (LAMB + 0.5)) ;
  7221. STM = SIN THETAM ;
  7222. CTM = COS THETAM ;
  7223. AUX1 = 1. + LAMB ;
  7224. AUX2 = RHOM * CTM + RP ;
  7225. AUX3 = RHOM * STM ;
  7226. *
  7227. *---- TEST : calcul du decentrement par la methode de Shafranov
  7228. DELT0 = B * (RHOM**2) / (2.*RP) ;
  7229. MESS '*** TEST : DELT0 *** '; LIST DELT0 ;
  7230. *---- FIN TEST
  7231. *
  7232. SI (IMETHOD EGA 1) ;
  7233. * ---- calcul du grand rayon
  7234. *
  7235. * RM 08/04/97 J'enleve STM qui figure a la fois au numerateur et au denominateur
  7236. *dans l'expression definie par les trois lignes suivantes
  7237. * Il provoque une division par 0 quand des points du maillage sont dans le plan
  7238. * equatorial
  7239. * GRANDR = RHOM * RP * CTM * (A - B) ;
  7240. GRANDR = GRANDR + (2.*(RP**2) - (B*(RHOM**2))) ;
  7241. GRANDR = GRANDR / (2.*RP + (RHOM*CTM*(A - B))) ;
  7242. FINSI ;
  7243. *
  7244. SI (IMETHOD EGA 2) ;
  7245. DELTA = ((AUX2**2) * (AUX1**2)) - ((AUX1 + 1.) * ( ((AUX2**2) + (AUX3**2)) * AUX1 - (RP**2) - ((RHO0**2) * AUX1))) ;
  7246. *
  7247. * ---- deux cercles possibles
  7248. GRANDR1 = ((AUX2 * AUX1) + (DELTA**0.5))/(AUX1 + 1.) ;
  7249. GRANDR2 = ((AUX2 * AUX1) - (DELTA**0.5))/(AUX1 + 1.) ;
  7250. *
  7251. * ---- choix du bon cercle
  7252. SI ((COS THETAM) >EG 0.) ;
  7253. GRANDR = GRANDR2 ;
  7254. SINON ;
  7255. GRANDR = GRANDR1 ;
  7256. FINSI ;
  7257. FINSI ;
  7258. *
  7259. *---- calcul du petit rayon
  7260. PETITR = ((RHOM*CTM+RP-GRANDR)**2 + ((RHOM*STM)**2))**0.5 ;
  7261. *
  7262. *--- calcul de theta dans le repere centre sur le cercle calcule
  7263. THETAR = ATG (RHOM * STM) (RHOM * CTM + RP - GRANDR) ;
  7264. *
  7265. *---- test (methode 1)
  7266. *AM*TERME1 = PETITR * LAMB * (COS THETAR) / GRANDR ;
  7267. *AM*TERME2 = (STM**2 * B + ((CTM**2) * A))/(2.*RP) ;
  7268. *AM*TERME2 = TERME2 + (CTM / RHOM) ;
  7269. *AM*TERME2 = TERME2 * (RP - GRANDR);
  7270. *AM*TERME2 = TERME2 + (RHOM * CTM * A / (2.*RP)) ;
  7271. *AM*ERREUR0 = (ABS ((TERME1-TERME2)/TERME2)) ;
  7272. *AM*MESS 'TEST'; LIST TERME1; LIST TERME2; LIST ERREUR0;
  7273. *
  7274. FINPROC GRANDR PETITR THETAR;
  7275.  
  7276. **** @CVECT
  7277. DEBPROC @CVECT XV*CHPOINT YV*CHPOINT ZV*CHPOINT MAIL0*MAILLAGE COUL0*MOT AMPLI0/FLOTTANT;
  7278. *
  7279. **************************************************************
  7280. * Procedure de creation d'un objet de type vecteur a partir *
  7281. * des composantes d'un champ de vecteurs. *
  7282. * Si le facteur d'amplification pour visualiser un champ de *
  7283. * vecteur sur une geometrie n'est pas donne,il est adapte *
  7284. * aux dimensions geometriques du probleme. *
  7285. * Alain MOAL (juillet 1995) *
  7286. **************************************************************
  7287. *
  7288. XM = COOR 1 MAIL0 ;
  7289. YM = COOR 2 MAIL0 ;
  7290. SI ((VALEUR DIME) EGA 2) ;
  7291. ZM = XM * 0. ;
  7292. SINON ;
  7293. ZM = COOR 3 MAIL0 ;
  7294. FINSI ;
  7295. *
  7296. SI (NON (EXISTE AMPLI0)) ;
  7297. * ---- norme du vecteur
  7298. VECNORM = ((XV * XV) + (YV * YV) + (ZV * ZV))**0.5 ;
  7299. * RM 16.01.03
  7300. mess '>> ccect' ;
  7301. @listmm VECNORM ;
  7302. *
  7303. * ---- calcul d'une longueur caracteristique du maillage
  7304. LONGCAR1 = ABS ((MAXI XM) - (MINI XM)) ;
  7305. LONGCAR2 = ABS ((MAXI YM) - (MINI YM)) ;
  7306. LONGCAR3 = ABS ((MAXI ZM) - (MINI ZM)) ;
  7307. *
  7308. SI ((VALEUR DIME) EGA 2) ;
  7309. LONGCAR = MINI (PROG LONGCAR1 LONGCAR2) ;
  7310. SINON ;
  7311. LONGCAR = MINI (PROG LONGCAR1 LONGCAR2 LONGCAR3) ;
  7312. FINSI ;
  7313. *
  7314. AMPLI0 = LONGCAR / (MAXI VECNORM) / 3.;
  7315. *AM* AMPLI0 = LONGCAR / (MAXI VECNORM) ;
  7316. *AM* AMPLI0 = 2. * LONGCAR / (MAXI VECNORM) ;
  7317. FINSI ;
  7318. *
  7319. SI ((VALEUR DIME) EGA 2) ;
  7320. CHV1 = @ET (NOMC UX XV) (NOMC UY YV) ;
  7321.  
  7322.  
  7323. *CAST94* CHV1 = (NOMC UX XV) ET (NOMC UY YV) ;
  7324. VECT1 = VECT CHV1 AMPLI0 UX UY COUL0 ;
  7325. SINON ;
  7326. CHV1 = @ET (@ET (NOMC UX XV) (NOMC UY YV)) (NOMC UZ ZV) ;
  7327. *CAST94* CHV1 = (NOMC UX XV) ET (NOMC UY YV) ET (NOMC UZ ZV) ;
  7328. VECT1 = VECT CHV1 AMPLI0 UX UY UZ COUL0 ;
  7329. FINSI ;
  7330. FINPROC VECT1 ;
  7331.  
  7332. **** ARBRE derniere modif 16/04/91
  7333. DEBPROC ARBRE MAILSEG*MAILLAGE IMEN*ENTIER;
  7334. * determination du maillage des aretes de la surface de separation
  7335. * en seg2 sera a changer si p2 au lieu de p1
  7336. * HDL CHPOINT VIDE SUR DFCAN EN ENTREE
  7337. MAILSEG = MAILSEG COUL BLAN ;
  7338. NPB= MAILSEG NBNO ;
  7339. IP= 0;
  7340. MESS ' ************************** ' ;
  7341. * TEMPS ;
  7342. MESS ' ************************** ' ;
  7343. MESS ' NBRE DE POINTS DE LA SURFACE DE SEPARATION ' NPB;
  7344. MESS ' NBRE D ELEMENTS DE LA SURFACE DE SEPARATION ' (MAILSEG NBEL);
  7345. IPASS= 0;IMA= 0 ;
  7346. REPETER BOUC1 ;
  7347. IPASS= IPASS + 1;IMA= IMA + 1 ;
  7348. ALBERT= MAILSEG ELEM BLAN ;
  7349. ITUR= 0;
  7350. REPETER BOUCON ;
  7351. ITUR= ITUR + 1 ;
  7352. P1= ALBERT POINT ITUR;
  7353. SEGBL= ALBERT ELEM 'APPUYE' LARGEMENT P1 ;NBL= SEGBL NBEL ;
  7354. SEGPT= MAILSEG ELEM 'APPUYE' LARGEMENT P1 ;NBT= SEGPT NBEL ;
  7355. SI (( NBL < NBT) OU ('EGA' IPASS 1)) ; QUITTER BOUCON ;FINSI ;
  7356. FIN BOUCON ;
  7357. SI (IPASS > 1);
  7358. * TRAC OEIL ((SEGBL COUL ROUG)
  7359. * ET (MAILSEG ELEM BLAN) ET (MAILSEG ELEM VERT)) NOEUDS;
  7360. FINSI ;
  7361. IBL= 0 ;
  7362. * on ordonne les segments connectes a P1 sens P1 PN
  7363. REPETER BOUC0 NBL ;
  7364. IBL= IBL + 1 ;
  7365. SSS= SEGBL ELEM IBL ; 1P= SSS POINT INITIAL ;2P= SSS POINT FINAL ;
  7366. SI ( 1P NEG P1 ) ; SSS= (INVE SSS) ; FINSI ;
  7367. SI (IBL EGA 1 ) ; SSI= SSS;SINON ;
  7368. SSI = SSI ET SSS ; FINSI ;
  7369. 2P= SSS POINT FINAL ;
  7370. FIN BOUC0 ;
  7371. SEGBL= SSI ;
  7372.  
  7373. * SI NBL > 1 ON VA ELIMINER LES DOUBLES DE SEGBL
  7374.  
  7375. IA=0 ;
  7376. SI ( NBL EGA 1 );SEG1= (SEGBL ELEM 1 ) COUL VERT ;
  7377. 2P= SEG1 POINT FINAL ;
  7378. MAILSEG= ( DIFF MAILSEG SEG1 ) ET SEG1 ;
  7379. FINSI ;
  7380. SI ( NBL > 1 ) ;
  7381. REPETER BOUC2 (NBL - 1 );
  7382. IA= IA + 1 ;
  7383. SEG1 = ( SEGBL ELEM IA ) COUL VERT ;
  7384. PP1= SEG1 POINT FINAL ;
  7385. I3= IA + 1 ;
  7386. REPETER BOUC3 ;
  7387. SI ( I3 > NBL ) QUITTER BOUC3 ; FINSI ;
  7388. SEG2 = SEGBL ELEM I3 ;
  7389. PP2=SEG2 POINT FINAL;
  7390. SI ( PP1 EGA PP2 ) ;
  7391. MAILSEG= (DIFF MAILSEG SEG2 );
  7392. * MESS ' ELIMINATION DU NO ' I3 ;
  7393. FINSI ;
  7394. I3= I3 + 1;
  7395. FIN BOUC3 ;
  7396. MAILSEG = ( DIFF MAILSEG SEG1 ) ET SEG1;
  7397. FIN BOUC2 ;
  7398. FINSI ;
  7399. N1= (MAILSEG ELEM VERT) NBEL ;N2= MAILSEG NBEL ;
  7400. * TRAC OEIL MAILSEG ;
  7401. SI ( N1 EGA N2 ) ; QUITTER BOUC1 ; FINSI ;
  7402. SI ( EGA IMA IMEN) ; MENAGE ;IMA = 0 ; FINSI ;
  7403. FIN BOUC1 ;
  7404. SAUTER 2 LIGNES ;
  7405. MESS ' NB D ARETES AYANT SERVI A L INTEGRATION ' N2 ;
  7406. MESS ' ************************** ' ;
  7407. *TEMPS ;
  7408. MAILSEG= MAILSEG ELEM VERT ;
  7409. * HDL= IN_MINI (MAILSEG ELEM VERT ) TABHS ORIG B_ANTI ;
  7410. FINPROC MAILSEG;
  7411. **** FL_HS derniere modif 16/04/91
  7412. DEBPROC FL_HS DFCANT*MAILLAGE TABHS*TABLE TYEL*MOT OBJV*MMODEL;
  7413. * chamelem des projections de hs sur les normales des elements
  7414. * au cdg
  7415. HPX=REDU (TABHS.1) DFCANT ;
  7416. HPY=REDU (TABHS.2) DFCANT ;
  7417. HPZ=REDU (TABHS.3) DFCANT ;
  7418. IP= 0;
  7419. OB1= DFCANT AFFECT (MODELE STANDARD ) TYEL ;
  7420. NBP= DFCANT NBNO ;
  7421. FLHS= MANU CHPO DFCANT 1 'Q' ( PROG NBP * 0. );
  7422. * calcul des moyennes sur l element
  7423. HSXM = PRCH HPX OB1 'GRAVITE' ;
  7424. HSYM = PRCH HPY OB1 'GRAVITE' ;
  7425. HSZM = PRCH HPZ OB1 'GRAVITE' ;
  7426. HNMP = MANU CHAM OB1 'GRAVITE' SCAL 0. ;
  7427. BBNEL= DFCANT NBEL ;
  7428. *
  7429. IP= 0 ;
  7430. IMENA= 0 ;
  7431. REPETER BOUCEL BBNEL ;
  7432. IMENA= IMENA + 1 ;
  7433. IP=IP + 1 ; TOTO= DFCANT ELEM IP ; ITOT= CHAN POI1 TOTO ;
  7434. T1= ITOT POINT 1 ;T2= ITOT POINT 2 ; T3= ITOT POINT 3 ;
  7435. * normale a l element
  7436. V1= T2 MOINS T1 ; V2= T3 MOINS T1 ; NNN= V1 PVECT V2 ;
  7437. NNNR= NNN / (NORM NNN) ;
  7438. CVX= COOR 1 NNNR ;CVY= COOR 2 NNNR ; CVZ= COOR 3 NNNR ;
  7439. HSXE= EXTR HSXM SCAL 1 IP 1 ;
  7440. HSYE= EXTR HSYM SCAL 1 IP 1 ;
  7441. HSZE= EXTR HSZM SCAL 1 IP 1 ;
  7442. VPROJ = (HSXE * CVX ) + (HSYE * CVY ) + (HSZE * CVZ) ;
  7443. FLHS1= FLHS + ( FLUX OBJV VPROJ TOTO ) ;
  7444. DETR FLHS ;FLHS = FLHS1 ;DETR TOTO ;DETR ITOT;
  7445. SI ( EGA IMENA 50 ) ; MESS ' menage ';
  7446. MENAGE ; IMENA= 0 ; FINSI ;
  7447. FIN BOUCEL ;
  7448. FINPROC FLHS ;
  7449. **** IN_MINI derniere modif 16/04/91
  7450. 'DEBPROC' IN_MINI FCAN*'MAILLAGE' TABHS*TABLE ORIG*POINT B_ANTI*MAILLAGE ;
  7451. * integration de v par minimisation fonctionnelle
  7452. * en entree maillage frontiere cote phi et hs sur ce maiilage
  7453. * en sortie V(b)= phi(b)-psi(b) chpoint sur fcan
  7454. * avec psi(p1) = phi(p1)
  7455. HX=TABHS.1;HY=TABHS.2;HZ=TABHS.3;
  7456. nbi = nbno ( fcan elem 1 ) ;
  7457. I= 0 ;
  7458. MESS ' SEPARATION ' (FCAN NBNO) 'POINTS' (FCAN NBEL) 'ELEM ';
  7459. REPE BLOCALC (NBEL FCAN);
  7460. I= I + 1 ;
  7461. SEGCOU = FCAN ELEM I;
  7462. P1 = SEGCOU POIN 1;
  7463. P2 = SEGCOU POIN 2;
  7464. HX1 = EXTR HX SCAL P1 ; HX2 = EXTR HX SCAL P2 ;
  7465. HY1 = EXTR HY SCAL P1 ; HY2 = EXTR HY SCAL P2 ;
  7466. HZ1 = EXTR HZ SCAL P1 ; HZ2 = EXTR HZ SCAL P2 ;
  7467. HMOY =(( HX1 + HX2) / 2.) ( ( HY1 + HY2) / 2.) ((HZ1 + HZ2) / 2.);
  7468. * si ( ega nbi 3 ) ;
  7469. * p3= segcou point 3 ;
  7470. * hmx= extr hx scal p3 ;
  7471. * hmy= extr hy scal p3 ;
  7472. * hmz= extr hz scal p3 ;
  7473. * hmil= ( hmx hmy hmz ) * 4. ;
  7474. * hmoy =( hmoy / 3. ) + ( hmil / 6. )
  7475. * finsi ;
  7476. VL= P2 MOINS P1 ;DL= NORM VL ;VL=VL / DL ;
  7477. DV = (VL PSCAL HMOY ) ;DVI= DV * -1.;
  7478. TI= 1. / DL ;IT= -1. * TI ;
  7479. RIGEL= MANU RIGIDITE SEGCOU (MOTS T ) (PROG TI IT TI) ;
  7480. HH= MANU CHPO SEGCOU 1 'Q' (PROG DVI DV );
  7481. SI (EGA I 1);
  7482. RIGT = RIGEL ;
  7483. HTH = HH ;
  7484. SINON ;
  7485. RIGT1= RIGT ET RIGEL;
  7486. HTH1= HTH ET HH ;
  7487. DETR RIGT;RIGT= RIGT1 ; DETR HTH ;HTH= HTH1 ;
  7488. DETR HH; DETR RIGEL ;
  7489. FINSI ;
  7490. FIN BLOCALC ;
  7491. TITI = RELA 'ENSE' T B_ANTI ;
  7492. TUTU= BLOQUE ORIG T;
  7493. HHHH= RESOU (RIGT ET TUTU ET TITI ) HTH ;
  7494. HHHH= (ENLEVER HHHH LX ) NOMC 'SCAL';
  7495. FINPROC HHHH ;
  7496. **** ARBRE_IN derniere modif 16/04/91
  7497. DEBPROC ARBRE_IN DFCAN*MAILLAGE TABHS*TABLE ORIG*POINT ;
  7498. * CALCUL DE L ARBORESCENCE ET INTEGRATION DE HS.DL
  7499. * cette methode amene des differences suivant le chemin choisi
  7500. * il vaut mieux utiliser l autre ( minimisation)
  7501. * DFCAN SURFACE DE SEPARATION
  7502. * HDL CHPOINT VIDE SUR DFCAN EN ENTREE
  7503. NPB= DFCAN NBNO ;
  7504. HDL= MANU CHPO DFCAN 1 SCAL ( PROG NPB * 0.) ;
  7505.  
  7506. DFCAN= DFCAN COUL BLAN ;
  7507. DFCAN1 = DFCAN ELEM QUA4 ;NELSURF1= DFCAN1 NBEL;
  7508. DFCAN2 = DFCAN ELEM TRI3 ; NELSURF2= DFCAN2 NBEL;
  7509. MAILSEG= CONT ( DFCAN1 ELEM 1 );
  7510. I= 1 ;
  7511. REPE BOUCSEG1 ( NELSURF1 - 1 );
  7512. I = I + 1;
  7513. MAILSEG = MAILSEG ET (CONT (DFCAN1 ELEM I));
  7514. FIN BOUCSEG1;
  7515. I= 0 ;
  7516. REPE BOUCSEG2 NELSURF2;
  7517. I = I + 1;
  7518. MAILSEG = MAILSEG ET (CONT (DFCAN2 ELEM I));
  7519. FIN BOUCSEG2;
  7520.  
  7521. NPB= MAILSEG NBNO ;
  7522. IP= 0;
  7523. MESS ' ************************** ' ;
  7524. *TEMPS ;
  7525. MESS ' ************************** ' ;
  7526. MESS ' NBRE DE POINTS DE LA SURFACE DE SEPARATION ' NPB;
  7527. MESS ' NBRE D ELEMENTS DE LA SURFACE DE SEPARATION ' (MAILSEG NBEL);
  7528. IPASS= 0;
  7529. REPETER BOUC1 ;
  7530. IPASS= IPASS + 1;
  7531. ALBERT= MAILSEG ELEM BLAN ;
  7532. ITUR= 0;
  7533. REPETER BOUCON ;
  7534. ITUR= ITUR + 1 ;
  7535. P1= ALBERT POINT ITUR;
  7536. SEGBL= ALBERT ELEM 'APPUYE' LARGEMENT P1 ;NBL= SEGBL NBEL ;
  7537. SEGPT= MAILSEG ELEM 'APPUYE' LARGEMENT P1 ;NBT= SEGPT NBEL ;
  7538. SI (( NBL < NBT) OU ('EGA' IPASS 1)) ; QUITTER BOUCON ;FINSI ;
  7539. FIN BOUCON ;
  7540. DETR ALBERT ; DETR SEGPT ;
  7541. SI (IPASS > 1);
  7542. * TRAC OEIL ((SEGBL COUL ROUG)
  7543. * ET (MAILSEG ELEM BLAN) ET (MAILSEG ELEM VERT)) NOEUDS;
  7544. FINSI ;
  7545. IBL= 0 ;
  7546. * on ordonne les segments connectes a P1 sens P1 PN
  7547. REPETER BOUC0 NBL ;
  7548. IBL= IBL + 1 ;
  7549. SSS= SEGBL ELEM IBL ; 1P= SSS POINT INITIAL ;2P= SSS POINT FINAL ;
  7550. SI ( 1P NEG P1 ) ; SSS= (INVE SSS) ; FINSI ;
  7551. SI (IBL EGA 1 ) ; SSI= SSS;SINON ;
  7552. SSI1 = SSI ET SSS ;DETR SSI ; SSI = SSI1 ;
  7553. FINSI ;
  7554. 2P= SSS POINT FINAL ;DETR SSS ;
  7555. FIN BOUC0 ;
  7556. SEGBL= SSI ;
  7557.  
  7558. * SI NBL > 1 ON VA ELIMINER LES DOUBLES DE SEGBL
  7559.  
  7560. IA=0 ;
  7561. SI ( NBL EGA 1 );SEG1= (SEGBL ELEM 1 ) COUL VERT ;
  7562. 2P= SEG1 POINT FINAL ;
  7563. VV= EXTR HDL SCAL 2P ;
  7564. SI (( EGA VV 0.) ET (2P NEG ORIG));
  7565. HDL=INT_BIOT HDL P1 2P ORIG TABHS ;
  7566. FINSI ;
  7567. MAILSEG= ( DIFF MAILSEG SEG1 ) ET SEG1 ;
  7568. FINSI ;
  7569. SI ( NBL > 1 ) ;
  7570. REPETER BOUC2 (NBL - 1 );
  7571. IA= IA + 1 ;
  7572. SEG1 = ( SEGBL ELEM IA ) COUL VERT ;
  7573. PP1= SEG1 POINT FINAL ;
  7574. VV= EXTR HDL SCAL PP1 ;
  7575. SI ((EGA VV 0.) ET (PP1 NEG ORIG));
  7576. HDL=INT_BIOT HDL P1 PP1 ORIG TABHS ;
  7577. FINSI ;
  7578. I3= IA + 1 ;
  7579. REPETER BOUC3 ;
  7580. SI ( I3 > NBL ) QUITTER BOUC3 ; FINSI ;
  7581. SEG2 = SEGBL ELEM I3 ;
  7582. PP2=SEG2 POINT FINAL;
  7583. SI ( PP1 EGA PP2 ) ;
  7584. MAILSEG1= (DIFF MAILSEG SEG2 );DETR MAILSEG ;MAILSEG= MAILSEG1 ;
  7585. * MESS ' ELIMINATION DU NO ' I3 ;
  7586. FINSI ;
  7587. *tc mise en commentaire du finsi ci dessous
  7588. * FINSI;
  7589. I3= I3 + 1;
  7590. FIN BOUC3 ;
  7591. MAILSEG1 = ( DIFF MAILSEG SEG1 ) ET SEG1;
  7592. DETR MAILSEG ; MAILSEG= MAILSE1 ;
  7593. FIN BOUC2 ;
  7594. FINSI ;
  7595. N1= (MAILSEG ELEM VERT) NBEL ;N2= MAILSEG NBEL ;
  7596. * TRAC OEIL MAILSEG ;
  7597. SI ( N1 EGA N2 ) ; QUITTER BOUC1 ; FINSI ;
  7598. FIN BOUC1 ;
  7599. DETR SEGBL ;
  7600. SAUTER 2 LIGNES ;
  7601. MESS ' NB D ARETES AYANT SERVI A L INTEGRATION ' N2 ;
  7602. MESS ' ************************** ' ;
  7603. *TEMPS ;
  7604. MESS ' ************************** ' ;
  7605. * sortie hdl chpoint de V
  7606. FINPROC HDL ;
  7607. **** INT_BIOT derniere modif 16/04/91
  7608. DEBPROC INT_BIOT HDL*CHPOINT 1P*POINT 2P*POINT ORIG*POINT TABHS*TABLE ;
  7609. * integration de ht.dl sur le long des aretes sur la surface de
  7610. * separation
  7611. HSX= TABHS.1 ;HSY=TABHS.2;HSZ= TABHS.3 ;
  7612. * HDL EST LE STOCKAGE DU RESULTAT
  7613. * integrale sur le segment
  7614. XHS1= EXTR HSX SCAL 1P;YHS1= EXTR HSY SCAL 1P; ZHS1= EXTR HSZ SCAL 1P;
  7615. XHS2= EXTR HSX SCAL 2P;YHS2= EXTR HSY SCAL 2P; ZHS2= EXTR HSZ SCAL 2P;
  7616. XHM= (XHS1 + XHS2 ) / 2.;
  7617. YHM= (YHS1 + YHS2 ) / 2.;
  7618. ZHM= (ZHS1 + ZHS2 ) / 2.;
  7619. DL= 2P MOINS 1P ;
  7620. INTSEG=(XHM * (COOR 1 DL)) + (YHM * (COOR 2 DL)) +(ZHM * (COOR 3 DL));
  7621. VAL = EXTR HDL SCAL 1P ;
  7622. VINT = VAL + INTSEG ;
  7623. *LIST (1P ET 2P);
  7624. *MESS 'VAL1P INTSEG VINT2P ' VAL INTSEG VINT ;
  7625. * le cas ou 2p est ORIG a ete exclu a l exterieur
  7626. HDL= HDL + ( MANU CHPO 2P 1 SCAL VINT ) ;
  7627. FINPROC HDL;
  7628. **** SAUT_POT derniere modif 16/04/91
  7629. DEBPROC SAUT_POT FCAN*MAILLAGE FFER*MAILLAGE LLLL*CHPOINT ORIG*POINT ;
  7630. * calcul du saut de potentiel
  7631. ***************************************************************
  7632. * relations entre points homologues de la separation
  7633. * orig est le point ou psi=phi=0.
  7634. * attention a la coherence avec la condition limite
  7635. ***************************************************************
  7636. NNN= FCAN NBNO;
  7637. IK= 0 ;ILO= 0 ;
  7638. REPETER BLOC1 NNN;
  7639. IK= IK + 1 ;
  7640. IP=FCAN POINT IK ;IQ= FFER POINT PROCHE IP ;
  7641. SI (NEG IP ORIG) ;
  7642. RELP= RELA 1. T IP - 1. T IQ ;
  7643. DEPIP= DEPIMP RELP (EXTR LLLL SCAL IP);
  7644. SI (EGA ILO 0 ) ;
  7645. REL1=RELP; FDEPI= DEPIP ;
  7646. ILO= 1 ;
  7647. SINON ;
  7648. REL2= REL1 ET RELP ;
  7649. FDEPI2= FDEPI ET DEPIP ;
  7650. DETR REL1 ; REL1= REL2 ; DETR FDEPI ; FDEPI= FDEPI2 ;
  7651. DETR RELP ;DETR DEPIP ;
  7652. FINSI;
  7653. FINSI;
  7654. FIN BLOC1 ;
  7655. FINPROC REL1 FDEPI;
  7656. **** B_ARETES derniere modif 16/04/91
  7657. DEBPROC B_ARETES SEP_PHI*MAILLAGE ;
  7658. * reduit un maillage surfacique p1 a ses aretes
  7659. * en conservant les doubles
  7660. NBU= SEP_PHI NBEL ;
  7661. DFCAN1 = SEP_PHI ELEM QUA4 ;NBQU= DFCAN1 NBEL ;
  7662. MAILSEG= CONT ( DFCAN1 ELEM 1 );
  7663.  
  7664. SI (NEG NBU NBQU);
  7665. DFCAN2 = SEP_PHI ELEM TRI3 ; NTRI= DFCAN2 NBEL;
  7666. I= 0 ;
  7667. REPE BOUCSEGT NTRI;
  7668. I = I + 1;
  7669. MAILSEG = MAILSEG ET (CONT (DFCAN2 ELEM I));
  7670. FIN BOUCSEGT;
  7671. FINSI ;
  7672. I= 1 ;
  7673. REPE BOUCSEGQ (NBQU - 1 );
  7674. I = I + 1;
  7675. MAILSEG = MAILSEG ET (CONT (DFCAN1 ELEM I));
  7676. FIN BOUCSEGQ;
  7677. TITRE 'MAILSEG ' (MAILSEG NBEL );
  7678. * TRAC OEIL MAILSEG QUAL ;
  7679. FINPROC MAILSEG ;
  7680.  
  7681. *
  7682. **** LIRBIOT derniere modif 16/04/91
  7683. DEBPROC LIRBIOT SEP_PHI*MAILLAGE MU0*FLOTTANT ;
  7684. ***************************************************************
  7685. * RECUP BIOT ET SAVART SUR FRONTIERE
  7686. * genere en exterieur la surface frontiere a ete sortie pas sort
  7687. * noopt precedement et a servi a calculer hs
  7688. * on recupere le tout coordonnees et hs et on elmine pour etre sur
  7689. * du support (ordre )
  7690. ***************************************************************
  7691. NFN=SEP_PHI NBNO ;
  7692. IMET= 2 ;
  7693. SI ( EGA IMET 1);
  7694. OPTION ACQUERIR 9 ;
  7695.  
  7696. ACQUERIR HX*LISTREEL NFN HY*LISTREEL NFN HZ*LISTREEL NFN ;
  7697. HS= MANU CHPO SEP_PHI 3 'HX' HX 'HY' HY 'HZ' HZ ;
  7698. SINON ;
  7699.  
  7700. * AUTRE FACON A ESSAYER
  7701. *
  7702. PPRO= PROG NFN * 0 ;
  7703. HS= MANU CHPO SEP_PHI 3 'HX' PPRO 'HY' PPRO 'HZ' PPRO ;
  7704. OPTION ACQUERIR 8 ;
  7705. IP= 0;
  7706. REPETER BOUCA NFN ;
  7707. ACQUERIR X*FLOTTANT Y*FLOTTANT Z*FLOTTANT HX*FLOTTANT HY*FLOTTANT HZ*FLOTTANT ;
  7708. * X= EXTR VALP 1 ;Y= EXTR VALP 2 ; Z= EXTR VALP 3;
  7709. * HX= EXTR VALP 4 ;HY= EXTR VALP 5 ; HZ= EXTR VALP 6;
  7710. P1= X Y Z ; PT= SEP_PHI POINT PROCHE P1 ;
  7711. HP= MANU CHPO PT 3 'HX' HX 'HY' HY 'HZ' HZ ;
  7712. HS2 = HS + HP ; DETR HS ; HS= HS2 ;
  7713. *tc mise en commentaire du finsi cidessous
  7714. * FINSI ;
  7715. *
  7716. FIN BOUCA;
  7717. FINSI;
  7718. * provisoire chambob donne B on divise par mu0
  7719. HS= HS / MU0 ;
  7720. * ELIM .1 SEP_PHI PT ;
  7721. FINPROC HS ;
  7722. **** FOR_CONT derniere modif 16/04/91
  7723. DEBPROC FOR_CONT CCONT*MAILLAGE SOL1*CHPOINT COURI*FLOTTANT;
  7724. * calcul des forces par integrale de contour
  7725. OBSEG = CCONT AFFECT ( MODELE STANDARD ) SEG2 ;
  7726. AA = PRCH OBSEG SOL1 'GRAVITE';
  7727. NBSEG = CCONT NBEL ;
  7728. IEL = 0 ;SOMX = 0. ; SOMY = 0. ;SMM = 0. ;
  7729. *
  7730. REPETER BOUC NBSEG ;
  7731. IEL = IEL + 1 ; SEGC= CCONT ELEM IEL ;
  7732. I1 = SEGC POINT INITIAL ; I2 = SEGC POINT FINAL ;
  7733. X1 = COOR 1 I1 ; X2 = COOR 1 I2 ; RX = ( X1 + X2) / 2. ;
  7734. Y1 = COOR 2 I1 ; Y2 = COOR 2 I2 ; RY = ( Y1 + Y2) / 2. ;
  7735. DX = X2 - X1 ; DY = Y2 - Y1 ;
  7736. AME = EXTR AA 'SCAL' 1 IEL 1 ;
  7737. SOMX = SOMX + ( AME * DX) ;
  7738. SOMY = SOMY + ( AME * DY) ;
  7739. MOMM = (RX * DX) + (RY * DY ) ;
  7740. SMM= SMM + ( AME * MOMM ) ;
  7741. FIN BOUC ;
  7742. *
  7743. FXX = COURI * SOMY ; FYY = -1. * COURI * SOMX ;
  7744. MOMT = -1. * COURI * SMM ;
  7745. CDG1 = BARY CCONT ;
  7746. RFORC = MANU CHPO CDG1 2 'FX' FXX 'FY' FYY ;
  7747. FINPROC RFORC SMM ;
  7748. **** FORBLOC derniere modif 16/04/91
  7749. DEBPROC FORBLOC BLOC*MAILLAGE BX*CHAMELEM BY*CHAMELEM OBJO*MMODEL COUR*FLOTTANT ;
  7750. * bobi maillage non complexe
  7751. * bb champ induction AUX CDG du maillage reduit
  7752. * integration de j vectoriel b sur les elements resultats aux cdg
  7753. * sort un champ par points aux cdgs dans rfor
  7754. * sort un champ par point aux noeuds dans rpt
  7755. NNN= BLOC NBEL ;
  7756. IP= 0 ;IPAS= 0 ;
  7757. REPETER BOUE NNN ;
  7758. IPAS= IPAS + 1 ;
  7759. IP = IP + 1 ; IEL =BLOC ELEM IP ;CDG= BARY IEL ;
  7760. EL_SUR= MAXI (RESU (SOURCE OBJ0 COUR IEL ));
  7761. FEX= (EXTR BY 'SCAL' 1 IP 1 ) * EL_SUR;FEX= FEX * -1. ;
  7762. FEY= (EXTR BX 'SCAL' 1 IP 1 ) * EL_SUR;
  7763. R_F= MANU CHPO CDG 2 'FX' FEX 'FY' FEY ;
  7764. NNI = IEL NBNO ;
  7765. RFXP= MANU CHPO IEL 1 'FX' ( PROG NNI * ( FEX / NNI )) ;
  7766. RFYP= MANU CHPO IEL 1 'FY' ( PROG NNI * ( FEY / NNI )) ;
  7767. SI ( EGA IP 1) ;RFOR = R_F ;RPX = RFXP ;RPY=RFYP ;
  7768. SINON ;
  7769. RFOR = RFOR + R_F ;RPX= RPX + RFXP ; RPY= RPY + RFYP ;
  7770. FINSI ;
  7771. * SI ( EGA IPAS 10 ) ;MESS 'menage';MENAGE ; IPAS = 0 ; FINSI ;
  7772. RPT= RPX + RPY ;
  7773. FIN BOUE ;
  7774. *
  7775. FINPROC RFOR RPT ;
  7776. **** INDUCTIO derniere modif fevrier/92
  7777. ******************************************************************
  7778. DEBPROC INDUCTIO GEO*MAILLAGE SOL1*CHPOINT AXI*LOGIQUE ;
  7779. ****************************************************************
  7780. * 2D UNIQUEMENT
  7781. * calcul; de l induction en potentiel vecteur *
  7782. * GEO maillage sur lequel on recherche B *
  7783. * SOL1 solution en potentiel vecteur *
  7784. * AXI logique vrai si axi *
  7785. ****************************************************************
  7786. OBJ0 = GEO MODE THERMIQUE ISOTROPE ;
  7787. GRA_ELR = GRAD OBJ0 SOL1 ;
  7788. DERIV = CHAN CHPO GRA_ELR OBJ0 ;
  7789. SI ( AXI ) ;
  7790. IMET = 2 ;
  7791. SI ( EGA IMET 1 ) ;
  7792. mess '* methode 1';
  7793. 1SRAY = MUAXI2 GEO 1. 1 ;
  7794. FINSI ;
  7795. SI ( EGA IMET 2 ) ;
  7796. 1SRAY = MUAXI2 GEO 1. 2 ;
  7797. FINSI ;
  7798. mess '* axisymetrique methode 'imet ;
  7799. BX = ((EXCO DERIV 'T,Y') * 1SRAY * -1. ) NOMC 'BX' ;
  7800. BY = ((EXCO DERIV 'T,X' ) * 1SRAY ) NOMC 'BY' ;
  7801. SINON ;
  7802. mess '* probleme plan ';
  7803. BX = (EXCO DERIV 'T,Y') NOMC 'BX' ;
  7804. BY = (( EXCO DERIV 'T,X' )* -1.) NOMC 'BY' ;
  7805. FINSI ;
  7806. BTOT = BX + BY ;
  7807. FINPROC BTOT ;
  7808. **** POT_VECT derniere modif 1/03/92
  7809. DEBPROC POT_VECT MATAB*TABLE SOLIN/MOT ;
  7810. ********************************************************************
  7811. * MAGETOSTATIQUE 2D EN POTENTIEL VECTEUR *
  7812. ********************************************************************
  7813. * MATAB TABLE D ENTREE CONTENANT
  7814. * MATAB.'MU0' PERMEABILITE DE L AIR (PAR DEFAUT UNITE METRE *
  7815. * MATAB.'MUREL' MU RELATIF DEPART 2900 PAR DEFAUT *
  7816. * MATAB.'AIR' PARTIE AIR NON REDUITE A UN SUPER ELEMENT *
  7817. * MATAB.'FER' FER *
  7818. * MATAB.'MAITRES' POINT MAITRES SI SUPER ELEMENT *
  7819. * MATAB.'AIRSUP' PARTIE AIR TRAITEE EN SUPER (NON OBLIGATOIRE)*
  7820. * MATAB.'ENCS ' LIMITE A A NULL SUR LE SUPER ELEMENT (MAILL) *
  7821. * MATAB.'BLOCAGE' LIMITE A A NULL SUR LA ZONE STANDARD( MAILL) *
  7822. * MATAB.'COUR' TABLE DE TABLES CONTENANT LA DESCRIPTION DES *
  7823. * BLOCS DE COURANTS CONSTITUEE PAR UN OU DES *
  7824. * APPEL(S) A LA PROCEDURE DESCOUR *
  7825. * MATAB.'AXI' = VRAI SI PROBLEME AXISYMETRIQUE *
  7826. * SOLIN MOT OPTIONNNEL POUR LE CALCUL DU PREMIER PAS LINEAIRE*
  7827. ********************************************************************
  7828. * EN SORTIE MATAB CONTIENT LES OBJETS NECESSAIRES *
  7829. * AU CALCUL NON LINEAIRE *
  7830. * ET LA SOLUION DU PREMIER PAS SI DEMANDEE DS MATAB.'POTENTIEL *
  7831. ********************************************************************
  7832. AXI= FAUX ;
  7833. SI ( EXISTE MATAB 'AXI' ); AXI = MATAB.'AXI' ; FINSI ;
  7834. MUAIR = 4 * PI * 1.E-7 ;
  7835. SI ( EXISTE MATAB 'MU0') ;MUAIR = MATAB.'MU0' ;FINSI ;
  7836. SI ( EXISTE MATAB 'MUREL' ) ;
  7837. MUFER = MUAIR * (MATAB.'MUREL') ;
  7838. SINON ; MUFER = MUAIR * 2900 ;
  7839. FINSI ;
  7840. MATAB.'MUAIR'= MUAIR ;
  7841. AIR = MATAB.'AIR' ;
  7842. FER = MATAB.'FER' ;
  7843. OBJ1=MODE AIR THERMIQUE ISOTROPE ;
  7844. OBJ2=MODE FER THERMIQUE ISOTROPE ;
  7845. SI ( AXI ) ;
  7846. MAT1= MUAXI2 AIR MUAIR 1;
  7847. MAT2= MUAXI2 FER MUFER 1;
  7848. SINON ;
  7849. * rectification conductibilites
  7850. MAT1= MATE OBJ1 'K' ( 1. / MUAIR ) ;
  7851. MAT2= MATE OBJ2 'K' ( 1. / MUFER ) ;
  7852. FINSI ;
  7853. SI ( EXISTE MATAB 'AIRSUP') ;
  7854. AIRSUP = MATAB.'AIRSUP' ;
  7855. OBJ3=MODE AIRSUP THERMIQUE ISOTROPE ;
  7856. SI ( AXI ) ;
  7857. MAT3 = MUAXI2 AIRSUP MUAIR 1 ;
  7858. SINON;
  7859. MAT3= MATE OBJ3 'K' ( 1. / MUAIR ) ;
  7860. FINSI ;
  7861. SI ( EXISTE MATAB 'ENCS' );
  7862. RIGB= (CONDUC OBJ3 MAT3 ) ET ( BLOQUER (MATAB.'ENCS' ) T ) ;
  7863. SFAC = MATAB.'MAITRES';
  7864. SUP1 = SUPER 'RIGIDITE' RIGB SFAC ;
  7865. MATAB.'SUPER' = SUP1 ;
  7866. FINSI ;
  7867. FINSI ;
  7868. RIGA= CONDUC OBJ1 MAT1 ;
  7869. RIGF= CONDUC OBJ2 MAT2 ;
  7870. *
  7871. SI ( EXISTE MATAB 'MAITRES') ;
  7872. RIGCON= RIGA ET ( EXTRAI SUP1 'RIGI' );
  7873. SINON ;
  7874. RIGCON = RIGA ;
  7875. FINSI ;
  7876. * charge
  7877. TABCOUR = TABLE ;
  7878. TABCOUR = MATAB.'COUR';
  7879. III = INDEX TABCOUR ;
  7880. IZ= 'ENTIER' 0 ;
  7881.  
  7882. REPETER BOUC ;
  7883. IZ= IZ + 1 ;
  7884. SI ( 'NON' ('EXISTE' III IZ )) ;QUITTER BOUC ; FINSI ;
  7885. STN = TABCOUR.IZ ;GEO = STN.'GEO' ;
  7886. FEIZ = SOURCE OBJ1 1. GEO ;
  7887. SSS = EXTR (RESU FEIZ) 'Q' (( EXTR FEIZ MAIL ) POINT 1);
  7888. *
  7889. SI ( EXISTE STN 'AMP' ) ;
  7890. J = STN.'AMP' ;
  7891. STN.'AT' = SSS * J ;
  7892. SINON ;
  7893. SDO = STN.'AT' ;
  7894. J = SDO / SSS ;
  7895. STN.'AMP'= J ;
  7896. FINSI ;
  7897. *
  7898. FEIZ = FEIZ * J ;
  7899. *
  7900. MESS ' BLOC ' IZ ' JAMP ' J ' NI' STN.'AT' ;
  7901. SI ( EGA IZ 1 ) ; FE = FEIZ ; SINON ;
  7902. FE = FE + FEIZ ;
  7903. FINSI ;
  7904. FIN BOUC ;
  7905.  
  7906. MATAB.'RHS'= FE ;
  7907.  
  7908. MATAB.'RIGCON'= RIGCON;
  7909. MATAB.'RIGFER'= RIGF;
  7910. SI ( EXISTE SOLIN ) ;
  7911. MESS ' *****************************************************';
  7912. MESS ' * CALCUL DE LA SOLUTION LINEAIRE *';
  7913. MESS ' *****************************************************';
  7914. SI ( EXISTE MATAB 'BLOCAGE' );
  7915. BBB = BLOQUER ( MATAB.'BLOCAGE') T ;
  7916. MATAB.'BLOCAGE'= BBB ;
  7917. SOL1= RESOU ( RIGF ET RIGCON ET BBB ) (MATAB.'RHS') ;
  7918. SINON ;
  7919. SOL1= RESOU ( RIGF ET RIGCON ) (MATAB.'RHS') ;
  7920. FINSI ;
  7921. MATAB.'POTENTIEL'= SOL1 ;
  7922. FINSI ;
  7923. *
  7924. FINPROC ;
  7925. **** DESCOUR derniere modif 16/04/91
  7926. DEBPROC DESCOUR TAB*TABLE I*ENTIER BLOCI*MAILLAGE MM*MOT J*FLOTTANT ;
  7927. *******************************************************************
  7928. * DESCRIPTION D UNE ZONE DE COURANTS *
  7929. * TAB TABLE QUI CONTIENDRA LE DESCIPTIF DE TOUTES LES *
  7930. * ZONES DE COURANTS *
  7931. * I NUMERO D ORDRE DE LA ZONE DE COURANT *
  7932. * BLOCI ZONE DE COURANT TYPE MAILLAGE *
  7933. * MM MOT 'AMP' OU 'AT' *
  7934. * J FLOTTANT DENSITE DE COURANT OU AMPERES TOURS *
  7935. *******************************************************************
  7936. STN= TABLE ;
  7937. STN.'GEO'= BLOCI ;
  7938. SI ( EGA MM 'AMP') ;
  7939. STN.'AMP' = J ;
  7940. SINON ;
  7941. STN.'AT' = J ;
  7942. FINSI ;
  7943. TAB.I= STN ;
  7944. FINPROC ;
  7945. **** MAG_NLIN derniere modif 16/04/91
  7946. 'DEBPROC' MAG_NLIN ETAB*'TABLE ' ;
  7947. *----------------------------------------------------------------------*
  7948. * *
  7949. * INSPIRE DE TRANSIT1 *
  7950. * POUR TENIR COMPTE DE PLUSIEURS MATERIAUX DONT UN NON LINEAIRE *
  7951. * POUR TRAITER PB MAGNETOSTATIQUE *
  7952. * --------------- *
  7953. * *
  7954. * RESOLUTION D'UN PROBLEME DE MAGNETOSTATIQUE NON-LINEAIRE *
  7955. * EN REGIME PERMANENT,A L'AIDE DE LA METHODE DU POINT FIXE *
  7956. * ETAB, TABLE CONTENANT EN ENTREE : *
  7957. * OBLIGATOIRE *
  7958. * INDICE 'SOUSTYPE' THERMIQUE *
  7959. * INDICE 'AXI ' LOGIQUE VRAI EN 2D SI AXISYM ( PLAN DEFAUT) *
  7960. * *
  7961. * INDICE 'EVOCOND' EVOLUTION DE Mu CREE PAR LA PROCEDURE H_B *
  7962. * QUI REND LA COURBE AD HOC POUR POT VECT OU POT SCALAIRE *
  7963. * OPTIONNEL *
  7964. * INDICE 'CRITERE' CRITERE DE CONVERGENCE *
  7965. * INDICE 'OME' COEFF AMORTISSEMENT OSCI 0< OME < 1. *
  7966. * (10E-5 PAR DEFAUT) *
  7967. * INDICE 'NITER' REACTUALISATION DE LA CONDUCTIVITE TOUTES *
  7968. * LES NITER ITERATIONS (NITER=1 PAR DEFAUT) *
  7969. * INDICE 'NIVEAU' NIVEAU DE MESSAGES (NIVEAU=0 PAR DEFAUT) *
  7970. * INDICE 'ITERMAX' NOMBRE D'ITERATIONS MAXIMUM *
  7971. * (ITERMAX=10 PAR DEFAUT) *
  7972. ************************************************************************
  7973. * arguments fabriques dans les passages soit ds pot_vect ou pot_scal *
  7974. * INDICE 'FLUX' FLUX EQUIVALENTS *
  7975. * INDICE 'BLOCAGE' MATRICE DE BLOCAGE (CREEE PAR "BLOQUE") *
  7976. * INDICE 'IMPOSE' VALEURS IMPOSEES (CREE PAR "DEPI") *
  7977. * INDICE 'RIGCON ' RAIDEUR CONSTANTE *
  7978. * INDICE 'RIGFER ' RAIDEUR VARIABLE *
  7979. * ETAB CONTENANT EN SORTIE : *
  7980. * *
  7981. * INDICE 'POTENTIEL' POTENTIEL RESULTAT *
  7982. * *
  7983. * D.R., LE 7 JUILLET 1988.VERSION DU 18 JANVIER 1989. *
  7984. * MODIFIE PAR BAZE MAI 90
  7985. *----------------------------------------------------------------------*
  7986. CONVERGE = FAUX ;ETAB.CONVERGE= FAUX ;
  7987. 'REPETER' PROC 1 ;
  7988. 'SI' ( 'NEG' ( ETAB.'SOUSTYPE' ) 'THERMIQUE' ) ;
  7989. 'MESS' 'SOUS TYPAGE INCORRECT DE LA TABLE EN ENTREE|' ;
  7990. 'QUITTER' PROC ;
  7991. 'FINSI' ;
  7992. 'SI' ( 'EXISTE' ETAB 'NIVEAU' ) ;
  7993. NIV_MESS = ETAB.'NIVEAU' ;
  7994. 'SINON' ;
  7995. NIV_MESS = 0 ;
  7996. 'FINSI' ;
  7997. 'SI' ( NIV_MESS '>EG' 1 ) ;
  7998. 'SAUTER' 1 'LIGNE' ;
  7999. 'MESS' '*** DEBUT DE LA PROCEDURE "MAG_NONLIN" ***' ;
  8000. 'FINSI' ;
  8001. *
  8002. *--- RECUPERATION DE L'INFORMATION CONTENUE DANS "ETAB"
  8003. *
  8004. 'SI' ('EXISTE' ETAB BLOCAGE );
  8005. MAT_BLO = ETAB.'BLOCAGE' ;
  8006. 'FINSI';
  8007. RIG_CON = ETAB.'RIGCON';
  8008. 'SI' ( 'EXISTE' ETAB 'IMPOSE' );
  8009. VAL_IMPO = ETAB.'IMPOSE' ;
  8010. 'FINSI' ;
  8011. * IL FAUT EXTRAIRE LE FER ;
  8012. FER = EXTRA ( ETAB.RIGFER ) MAIL;
  8013. AXI = FAUX ;
  8014. SI ( EXISTE ETAB 'AXI') ; AXI = ETAB.'AXI' ;FINSI ;
  8015. SI AXI ;
  8016. obmod = MODE FER THERMIQUE ISOTROPE ;
  8017. cp_rpoa = (coor 1 FER ) ;
  8018. ce_rpoa = CHAN 'CHAM' CP_RPOA OBMOD 'GRAVITE';
  8019. RFER = CHAN CHPO OBMOD (CHAN 'NOEUD' OBMOD ce_rpoa );
  8020. FINSI ;
  8021. * SI ( EXISTE ETAB 'SUPER' ) ;
  8022. MAIL_CHP= FER ET ( EXTRA RIG_CON MAIL );
  8023. * SINON ;
  8024. * MAIL_CHP= ETAB.'GEORED' ;
  8025. * FINSI ;
  8026. NBRE_NOE = 'NBNO' MAIL_CHP ;
  8027. VEC1= MANU CHPO MAIL_CHP 1 'T' (PROG NBRE_NOE * 1. ) ;
  8028. QTE_FLUX = ETAB.'RHS' ;
  8029. EVO_COND = ETAB.'EVOCOND' ;
  8030. LIS_COND = 'EXTRAIRE' EVO_COND 'CONDUCTIVITE' ;
  8031. LIS_TEMP = 'EXTRAIRE' EVO_COND 'TEMPERATURE' ;
  8032. VAL_COND=EXTR LIS_COND 1 ;
  8033. * SAUTER 3 LIGNES ;
  8034. * MESS ' CONDUCTIVITE INITIALE DU FER ' VAL_COND ;
  8035. SAUTER 3 LIGNES ;
  8036. 'SI' ( 'EXISTE' ETAB 'CRITERE' ) ;
  8037. EPSILON = ETAB.'CRITERE' ;
  8038. 'SINON' ;
  8039. EPSILON = 1.E-5 ;
  8040. 'FINSI' ;
  8041. 'SI' ( 'EXISTE' ETAB 'NITER' ) ;
  8042. NBRE_ITE = ETAB.'NITER' ;
  8043. 'SI' ( NIV_MESS '>EG' 1 ) ;
  8044. 'SAUTER' 1 'LIGNE' ;
  8045. 'MESS' 'REACTUALISATION DE LA MATRICE DE CONDUCTIVITE A L ENTREE ' 'PUIS TOUTES LES ' NBRE_ITE 'ITERATIONS' ;
  8046. 'FINSI' ;
  8047. 'SINON' ;
  8048. NBRE_ITE = 1 ;
  8049. 'FINSI' ;
  8050. 'SI' ( 'EXISTE' ETAB 'ITERMAX' ) ;
  8051. ITER_MAX = ETAB.'ITERMAX' ;
  8052. 'SINON' ;
  8053. ITER_MAX = 10 ;
  8054. 'FINSI' ;
  8055. **************************
  8056. OBJ_MFER = 'MODE' FER 'THERMIQUE' 'ISOTROPE' ;
  8057. 'SI' ( 'EXISTE' ETAB 'IMPOSE');
  8058. FF1 = QTE_FLUX 'ET' VAL_IMPO ;
  8059. 'SINON';
  8060. FF1 = QTE_FLUX;
  8061. 'FINSI';
  8062. ome= ETAB.'OME' ;
  8063. 'SI' ('NON' ( 'EXISTE' ETAB 'POTENTIEL')) ;
  8064. MESS '*************************************************************';
  8065. MESS '************** CALCUL INITIAL *******************************';
  8066. MESS 'SUPPOSE UN PASSAGE PREALABLE AU MOINS DS POT_VECT OU POT_SCAL';
  8067. MESS '*************************************************************';
  8068. klast= manu chpo fer 1 'SCAL' ( prog ( fer nbno ) * val_cond );
  8069. SI ( AXI ) ;
  8070. KLAST = (KLAST * ( RFER ** -1. )) ;
  8071. CHAM_CND = CHAMELEM FER (KLAST 'NOMC' 'K') 'CARACTERISTIQUES';
  8072. SINON ;
  8073. CHAM_CND='MATE' OBJ_MFER 'K' VAL_COND ;
  8074. FINSI ;
  8075. CND1 = 'CONDUCTIVITE' OBJ_MFER CHAM_CND ;
  8076. 'SI' ( 'EXISTE' ETAB BLOCAGE ) ;
  8077. RIG1 = CND1 ET RIG_CON ET MAT_BLO ;
  8078. 'SINON';
  8079. RIG1 = CND1 ET RIG_CON ;
  8080. 'FINSI' ;
  8081. U1_T = 'RESOUDRE' RIG1 FF1 ;
  8082. ETAB.'POTENTIEL'= U1_T ENLEVER LX ;
  8083. * CI= (LUMP RIG1 ) * VEC1 ; C2= (LUMP RIG1 ( MOTS T )) * VEC1 ;
  8084. * CI = (C2 - CI ) NOMC 'SCAL';
  8085. SINON ;
  8086. MESS ' ******************************************************';
  8087. MESS ' ****************** REPRISE *****************';
  8088. MESS ' ******************************************************';
  8089. SI (EXISTE ETAB 'KLAST') ;
  8090. KLAST= ETAB.'KLAST' ;
  8091. SINON ;
  8092. klast= manu chpo fer 1 'SCAL' ( prog ( fer nbno ) * val_cond );
  8093. FINSI ;
  8094. U1_T = 'EXCO' ( ETAB.'POTENTIEL') 'T' 'NOID' 'T' ;
  8095. * CI = ETAB.'CI' ;
  8096. MESS ' menage ' ; MENAGE ;
  8097. FINSI ;
  8098. 'SI' ( NIV_MESS '>EG' 2 ) ;
  8099. 'SAUTER' 1 'LIGNE' ;
  8100. 'MESS' 'CHAMP THERMIQUE AVANT ITERATION ' ;
  8101. 'LISTE' U1_T ;
  8102. 'FINSI' ;
  8103. DAN= 1.;
  8104. *
  8105. MOESP='REA' ;
  8106. *
  8107. MESS ' AMAX AMIN DU/U ';
  8108. *
  8109. ***********************************************************
  8110. *--- ... ITERATIONS ...
  8111. ***********************************************************
  8112. NUM_ITE = 0 ;
  8113. IFOIS = 0 ;
  8114. 'REPETER' BOUC_1 ;
  8115. NUM_ITE = NUM_ITE + 1 ;
  8116. IFOIS = IFOIS + 1 ;
  8117. *
  8118. * calcul du champ dans le fer -----> modif de mufer
  8119. U1_FER=REDU U1_T FER ;
  8120. DERIV= CHAN CHPO ( GRAD OBJ_MFER U1_FER) OBJ_MFER;
  8121. SI ( AXI ) ;
  8122. DERIV = DERIV / RFER ;
  8123. FINSI ;
  8124. SI (EXISTE DERIV 'T,Z' ) ;
  8125. DAX= (EXCO DERIV 'T,X') NOMC SCAL;
  8126. DAY= (EXCO DERIV 'T,Y') NOMC SCAL;
  8127. DAZ= (EXCO DERIV 'T,Z') NOMC SCAL;
  8128. BB= (( DAY * DAY ) + ( DAX * DAX ) +( DAZ * DAZ )) ** .5 ;
  8129. BB= BB NOMC T ;
  8130. SINON ;
  8131. DAX= (EXCO DERIV 'T,X') NOMC SCAL ;
  8132. DAY= (EXCO DERIV 'T,Y') NOMC SCAL ;
  8133. BB= ((( DAY * DAY ) + ( DAX * DAX ) ) ** .5 ) NOMC T ;
  8134. FINSI ;
  8135.  
  8136. BMAX= MAXIMUM BB ;BMIN= MINI BB ;
  8137. MESS IFOIS MOESP ' ** CHAMP MAXI MINI FER ' BMAX BMIN ;
  8138. * SAUTER 1 LIGNE ;
  8139.  
  8140. K1 = 'IPOL' BB LIS_TEMP LIS_COND ;
  8141. K1= COLI (K1 NOMC 'SCAL') OME KLAST (1. - OME) ;
  8142. KLAST = K1 ;
  8143. K2 = 'NOMC' 'K' K1 ;
  8144. SI ( AXI ) ;
  8145. K2 = (K2 * ( RFER ** -1. )) NOMC 'K' ;
  8146. CHAM_CND = CHAMELEM FER K2 'CARACTERISTIQUES';
  8147. SINON ;
  8148. CHAM_CND = 'CHAMELEM' FER K2 'CARACTERISTIQUES' ;
  8149. FINSI ;
  8150. CND2 = 'CONDUCTIVITE' OBJ_MFER CHAM_CND ;
  8151. RR2= CND2 ET RIG_CON ;
  8152. RESID= ( FF1 - ( RR2 * U1_T ) ) ENLEVER 'FLX' ;
  8153. *
  8154. * tests de convergence
  8155. *
  8156. RESID= RESID NOMC 'SCAL';
  8157. NORES= (XTX RESID ) ** .5 ;
  8158. ERRMAX= MAXI ( ABS RESID ) ;
  8159. MAXA= MAXI U1_T ;MIXA= MINI U1_T ;
  8160. DETR RESID ;
  8161. MESS IFOIS MAXA MIXA DAN ;
  8162. *
  8163. *
  8164. 'SI' (( NUM_ITE 'EGA' NBRE_ITE ) 'OU' ( IFOIS 'EGA' 1 ) );
  8165. *****************************************************************
  8166. * --- REACTUALISATION DE LA MATRICE DE CONDUCTIVITE
  8167. *****************************************************************
  8168. MOESP='REA' ;
  8169. * CI= (LUMP RR2 ) * VEC1 ; C2= (LUMP RR2 ( MOTS T )) * VEC1 ;
  8170. * CI = (C2 - CI ) NOMC 'SCAL';
  8171. 'SI' ( 'EXISTE' ETAB BLOCAGE );
  8172. RIG1 = RR2 ET MAT_BLO ;
  8173. 'SINON';
  8174. RIG1 = RR2 ;
  8175. 'FINSI' ;
  8176. U2 = 'RESOUDRE' RIG1 FF1 ;
  8177. NUM_ITE = 0 ;
  8178. 'SINON' ;
  8179. *****************************************************************
  8180. * --- RE-EQUILIBRAGE DU SECOND MEMBRE
  8181. *****************************************************************
  8182. MOESP=' ' ;
  8183. FF2 = ( RIG1 * U1_T ) - ( RR2 * U1_T ) ;
  8184. FF3 = FF1 + FF2 ;
  8185. U2 = 'RESOUDRE' RIG1 FF3 ;
  8186. * 'DETR' CND2 ;DETR RR1 ; DETR RR2 ;
  8187. 'FINSI' ;
  8188. *****************************************************************
  8189. *****************************************************************
  8190. U2_T = 'EXCO' U2 'T' 'NOID' 'T' ;
  8191. *
  8192. 'SI' ( NIV_MESS '>EG' 2 ) ;
  8193. 'SAUTER' 1 'LIGNE' ;
  8194. 'MESS' 'CHAMP THERMIQUE A L ITERATION :' IFOIS ;
  8195. 'LISTE' U2_T ;
  8196. 'FINSI' ;
  8197. *
  8198. CDIF= U2_T - U1_T ;
  8199. DAN= (XTX CDIF) / ( XTX U1_T) ;
  8200. DAN = DAN ** .5 ;
  8201. *
  8202. * 'SI' ( ERROR < EPSILON ) ;
  8203. 'SI' ( DAN < EPSILON ) ;
  8204. CONVERGE = VRAI ;
  8205. 'SINON' ;
  8206. CONVERGE = FAUX ;
  8207. 'FINSI' ;
  8208. *
  8209. *--- LE CRITERE DE CONVERGENCE EST-IL SATISFAIT ?
  8210. MENAGE ;
  8211.  
  8212. 'SI' ( CONVERGE ) ;
  8213. 'SI' ( NIV_MESS '>EG' 1 ) ;
  8214. * 'SAUTER' 1 'LIGNE' ;
  8215. 'MESS' 'CONVERGENCE A L ITERATION :' IFOIS ;
  8216. 'MESS' 'CRITERE DE CONVERGENCE :' EPSILON ;
  8217. 'FINSI' ;
  8218. 'QUITTER' BOUC_1 ;
  8219. 'FINSI' ;
  8220. U1_T = U2_T ;
  8221. 'SI' ( 'EGA' IFOIS ITER_MAX ) ;
  8222. * 'SAUTER' 1 'LIGNE' ;
  8223. 'MESS' 'PAS DE CONVERGENCE A L ITERATION :' ITER_MAX ;
  8224. ETAB.CONV = CONVERGE ;
  8225. 'QUITTER' BOUC_1 ;
  8226. 'FINSI' ;
  8227. * ON FAIT LE MENAGE
  8228. 'FIN' BOUC_1 ;
  8229. ETAB.NBITER= IFOIS;
  8230. *
  8231. *--- ARCHIVAGE DES RESULTATS DANS "ETAB"
  8232. *
  8233. ETAB.'KLAST'= KLAST ;
  8234. ETAB.'POTENTIEL' = U2_T ;
  8235. * ETAB.'CI'= CI ;
  8236. 'SI' ( NIV_MESS '>EG' 1 ) ;
  8237. 'SAUTER' 1 'LIGNE' ;
  8238. 'MESS' '*** FIN DE LA PROCEDURE "MAG_NLIN" ***' ;
  8239. 'FINSI' ;
  8240. 'FIN' PROC ;
  8241. 'FINPROC' ETAB ;
  8242. ************************
  8243. **** H_B derniere modif 16/04/91
  8244. DEBPROC H_B MU0*FLOTTANT POT_SCAL/MOT;
  8245. * definition de la courbe mu de b ou h
  8246. * mu0 systeme mksa 4 pi 10-7 ;
  8247. MUVRA = 4. * 3.14159 * 1.E-7 ;RAP= MU0 / MUVRA ;
  8248. * B= PROG 0. 1.09 1.5 1.57 1.67 1.81 1.92 2.01 20.1 ;
  8249. * H= PROG 0. 300 800 1250 3000 8000 13000 20000 200000 ;
  8250.  
  8251. 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.;
  8252. 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 ;
  8253. * TITRE ' COURBE H B A/M TESLAS ****** ';
  8254. * BHEVO=EVOL MANU 'H' H 'B' B ;
  8255. * DESS BHEVO;
  8256. * RECTIF POUR COHERENCE UNITES
  8257. H= H / RAP ;
  8258. H_1= ENLEVER H 1 ;B_1= ENLEVER B 1 ;
  8259. MUV= H_1 / B_1;TU= EXTRA MUV 1;MUV= ( PROG TU ) ET MUV ;
  8260. SI ('EXISTE' POT_SCAL );
  8261. BOBO= TEXTE ' MU F(H) POT SCAL ' ;
  8262. TITRE BOBO ;
  8263. REVOL = EVOL MANU 'TEMPERATURE ' H 'CONDUCTIVITE ' ( MUV ** -1.) ;
  8264. SINON ;
  8265. BOBO= TEXTE ' MU F(B) POT VECT ';
  8266. TITRE BOBO ;
  8267. REVOL=EVOL 'MANU' 'TEMPERATURE' B 'CONDUCTIVITE' MUV ;
  8268. FINSI ;
  8269. SAUTER 3 LIGNES ;
  8270. MESS BOBO ;
  8271. SAUTER 3 LIGNES ;
  8272. FINPROC REVOL ;
  8273. *
  8274. **** POT_SCAL derniere modif 10/02/92
  8275. DEBPROC POT_SCAL TABGEO*TABLE SOLIN/MOT ;
  8276. *********************************************************************
  8277. * procedure de mise en place des elements d un calcul 3d *
  8278. * magnetostatique potentiel scalaire reduit et total *
  8279. * DPHI zone de potentiel reduit *
  8280. * DPsI zone de potentiel total
  8281. ***** desciption du domaine dphi ( pas de super pour le moment)****
  8282. * TABGEO.'DPHI' = geometrie DPHI *
  8283. * TABGEO.'SEPPHI'= surface de separation appartient a DPHI
  8284. * attention pour le moment on doit verifier l orientation de la *
  8285. * normale a sepphi ( exterieure ) en attendant extension de flux *
  8286. * TABGEO.'B_ANTI' = partie de sepphi appartenant a la limite *
  8287. * TABGEO.'MUAIR' = mu0 *
  8288. * d antisymetrie pour B *
  8289. *******description du domaine dpsi **********************************
  8290. * on donne la descprition du fer puis une table tdolin de tables *
  8291. * contenant chacune la descrition d un sous domaine *
  8292. * TABGEO.'FER' =zone du fer appartient a DPSI
  8293. * TABGEO.'MUFER' = mufer ( mu0 * murelatif) valeur de depart *
  8294. * TABGEO.'TDOLIN'
  8295. * TDOLIN.I = TABLE STN *
  8296. * STN.'GEO' = maillage du sous domaine *
  8297. * STN.'MU' = permeabilite
  8298. * eventuellement *
  8299. * STN.'BLOCAGE'= type maillage *
  8300. * STN.'IMPOSE' = type chpoint *
  8301. * STN.'MAITRES' = type maillage *
  8302. * *
  8303. * TABGEO.'SEPPSI'= surface de separation appartient a DPSI *
  8304. * TABGEO.'ORIG' = point ou on impose PHI = PSI *
  8305. * TABGEO.'BLOQUE' = condition limite generale (sauf super elements) *
  8306. * TABGEO.'BIOT' = table contenant le champ de la bobine sur DPHI *
  8307. * TABGEO.'MAILSEG' = elements d aretes de sep_phi (optionnel) *
  8308. * la routine l etablira si il n existe pas *
  8309. * TABGEO.'LISMO1' = listmot de elements de volumes utilises *
  8310. * TABGEO.'LISMO2' = listmot de elements de surface utilises *
  8311. * SOLIN si present on calcule un la solution lineaire *
  8312. * si absent le premier pas sera fait dans MAG_NLIN *
  8313. * jm baze aout 90 *
  8314. *********************************************************************
  8315. MU0 = TABGEO.'MUAIR' ;
  8316. SI ( EXISTE TABGEO 'DPHI' ) ;
  8317. MESS '*************************************************************';
  8318. MESS '*********** POTENTIEL REDUIT ---- POTENTIEL TOTAL *********';
  8319. MESS '*************************************************************';
  8320. DPHI = TABGEO.'DPHI' ;
  8321. SEP_PHI= TABGEO.'SEPPHI';
  8322. B_ANTI = TABGEO.'B_ANTI';
  8323. SEP_PSI= TABGEO.'SEPPSI';
  8324. ORIG = TABGEO.'ORIG' ;
  8325. TABHT= TABGEO.'BIOT';
  8326. LIMO1= TABGEO.'LISMO1';
  8327. LIMO2= TABGEO.'LISMO2';
  8328. * reduction de biot et savart sur sep_phi
  8329. TABHS= TABLE ;
  8330. TABHS.1 = REDU ( TABHT.1 ) SEP_PHI ;
  8331. TABHS.2 = REDU ( TABHT.2 ) SEP_PHI ;
  8332. TABHS.3 = REDU ( TABHT.3 ) SEP_PHI ;
  8333. sauter 5 lignes ;
  8334. MMM= TEXTE ' THERMIQUE ISOTROPE ';
  8335. OBJPHI= MODE DPHI MMM;
  8336. MATPHI= MATE OBJPHI 'K' MU0 ; RIGCON=CONDUC OBJPHI MATPHI ;
  8337. MESS ' COORD POINT ORIGINE INTEGRATION DE V ';
  8338. LIST ORIG ;
  8339. sauter 5 lignes ;
  8340. MESS ' CALCUL DU FLUX DE HS SUR LES ELEMENTS FRONTIERE ';
  8341. NBLD= DIMENSION LIMO2 ;
  8342. MESS ' FLUX DE HS MU0 ';
  8343. TTTT= EXTR LIMO2 1 ;TTTI= EXTR LIMO1 1 ;
  8344. SEP_PHI1=SEP_PHI ELEM TTTI ;
  8345. FLHS = FL_HS SEP_PHI1 TABHS TTTT OBJPHI ;
  8346. SI ( EGA NBLD 2 ) ;
  8347. TTTT= EXTR LIMO2 2 ;TTTI= EXTR LIMO1 2 ;
  8348. SEP_PHI2=SEP_PHI ELEM TTTI ;
  8349. FLHS2 = FL_HS SEP_PHI2 TABHS TTTT OBJPHI;
  8350. FLHS = FLHS + FLHS2 ;
  8351. FINSI ;
  8352. * TEMPS PLACE ;
  8353. FLHS= FLHS * MU0 ;
  8354. FLURED = RESU FLHS ;
  8355. MESS ' RESULTANTE DU FLUX * MUO ' ( MAXI FLURED ) ;
  8356. sauter 5 lignes ;
  8357. * integration sur la surface de separation de l equation de
  8358. * de continuite tangentielle
  8359. SI ( 'EXISTE' TABGEO 'MAILSEG' ) ;
  8360. MAILSEG= TABGEO.'MAILSEG';
  8361. SINON ;
  8362. * decomposition de la surface de separation en element d aretes
  8363. MESS ' CALCUL DES ELEMENTS ARETES DE LA SEPARATION ';
  8364. RESEAU= B_ARETES SEP_PHI ;
  8365. imena = 50 ;
  8366. MAILSEG = ARBRE RESEAU IMENA ;
  8367. TABGEO.'MAILSEG'= MAILSEG ;
  8368. FINSI;
  8369. * TEMPS PLACE ;
  8370. MESS ' CALCUL DU SAUT DE POTENTIEL ';
  8371. METHOD = 1 ;
  8372. SAUTER 4 LIGNES ;
  8373. IMENA= 3 ;
  8374. SI (EGA METHOD 1) ;
  8375. MESS ' CALCUL PAR MINIMISATION ';
  8376. LLLL= IN_MINI MAILSEG TABHS ORIG B_ANTI ;
  8377. SINON;
  8378. MESS ' CALCUL PAR INTEGRATION ';
  8379. LLLL = ARBRE_IN SEP_PHI TABHS ORIG ;
  8380. FINSI ;
  8381. *****************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1
  8382. TABGEO.'LLLL'=LLLL ;
  8383. MESS ' FIN DE CALCUL DU SAUT DE POTENTIEL ';
  8384. *
  8385. SEP_PHI = CHAN POI1 SEP_PHI ;
  8386. SEP_RED= DIFF SEP_PHI B_ANTI;
  8387. LRED= REDU LLLL SEP_RED ;
  8388.  
  8389. RELT FDEPI= SAUT_POT SEP_RED SEP_PSI LRED ORIG ;
  8390. MESS ' FIN D APPLICATION DU SAUT DE POTENTIEL ';
  8391. *****************
  8392. RIGCON = RIGCON ET RELT ;RHS = FLHS ET FDEPI ;
  8393. *****************
  8394. * LIST FSAUT ;
  8395. sauter 5 lignes ;
  8396. * TEMPS PLACE ;
  8397. SINON ;
  8398. SAUTER 5 LIGNES ;
  8399. MESS '*************************************************************';
  8400. MESS '*********** DPHI N EXISTE PAS --> POTENTIEL TOTAL *********';
  8401. MESS '*************************************************************';
  8402. SAUTER 5 LIGNES ;
  8403. FINSI ;
  8404. **
  8405. DFER = TABGEO.'FER' ;
  8406. MUFER = TABGEO.'MUFER' ;
  8407.  
  8408. OBJ2=MODE DFER MMM;
  8409. MAT2= MATE OBJ2 'K' MUFER ; RIGFER=CONDUC OBJ2 MAT2 ;
  8410. * boucle sur les domaines lineaires non contenus dans dphi
  8411. SI ('EXISTE' TABGEO 'DOLIN' );
  8412. TDOLIN = TABGEO.'DOLIN' ;
  8413. III = INDEX TDOLIN ;
  8414. IDOM = 0 ;
  8415. REPETER BOUCDOM ;
  8416. IDOM = IDOM + 1 ;
  8417. SI ( 'NON' ( 'EXISTE' III IDOM )) ; QUITTER BOUCDOM ;FINSI ;
  8418. STN = TDOLIN.IDOM ;
  8419. LIST STN ;
  8420. GEO = STN.'GEO' ;OBJI= MODE GEO MMM ;
  8421. MUI = STN.'MU' ;
  8422. MATI= MATE OBJI 'K' MUI ; RIGO=CONDUC OBJI MATI ;
  8423. *
  8424. SI ( EXISTE STN 'BLOQUE' ) ;
  8425. ENC1 = BLOQUER (STN.'BLOQUE') 'T';
  8426. RIGO = RIGO ET ENC1 ;
  8427. FINSI ;
  8428. SI ( EXISTE STN 'IMPOSE' ) ;
  8429. CHIMP = (STN.'IMPOSE' ) NOMC 'T';
  8430. MAII = EXTR CHIMP MAILLAGE ;
  8431. RIMP = BLOQUER MAII 'T' ; FPOTI = DEPIMP RIMP CHIMP ;
  8432. RIGO = RIGO ET RIMP ;RHS = RHS ET FPOTI ;
  8433. FINSI ;
  8434. SI ( EXISTE STN 'MAITRES');
  8435. ******************************************************************
  8436. * construction eventuelle du super element
  8437. ******************************************************************
  8438. * attention ici si il y a une charge OU UN IMPOSE
  8439. SUP1 = SUPER 'RIGIDITE' RIGO ( STN.'MAITRES' ) ;
  8440. RIGCON = RIGCON ET ( EXTRA SUP1 'RIGI' ) ;
  8441. SINON ;
  8442. RIGCON = RIGCON ET RIGO ;
  8443. FINSI ;
  8444. FIN BOUCDOM ;
  8445. * fin de la boucle sur les table de domaines lineaires de dpsi
  8446. FINSI ;
  8447. *
  8448. SI( EXISTE TABGEO 'IMPOSE') ;
  8449. MESS ' CONDITION GENERALE IMPOSEE ' ;
  8450. CHIMG = (TABGEO.'IMPOSE' ) NOMC 'T';
  8451. MAIG = EXTR CHIMG MAILLAGE ;
  8452. RIMG = BLOQUER MAIG 'T' ; FPOTG = DEPIMP RIMG CHIMG ;
  8453. RIGCON = RIGCON ET RIMG ;RHS = RHS ET FPOTG ;
  8454. FINSI ;
  8455. *
  8456. SI (EXISTE TABGEO 'BLOQUE') ;
  8457. MESS ' CONDITION GENERALE BLOQUEE ' ;
  8458. ENCG = BLOQUER (TABGEO.'BLOQUE') 'T';
  8459. RIGCON= RIGCON ET ENCG ;
  8460. TABGEO.'BLOCAGE' = ENCG ;
  8461. FINSI ;
  8462. *
  8463. *
  8464. SI ( EXISTE SOLIN ) ;
  8465. MESS '********************************************************* ';
  8466. MESS '***************** CALCUL LINEAIRE ******************** ';
  8467. MESS '********************************************************* ';
  8468.  
  8469. RIGT = RIGCON ET RIGFER ;
  8470. TABGEO.'RHS'= RHS ;
  8471. TABGEO.'RIGCON'= RIGCON ;
  8472. TABGEO.'RIGFER'= RIGFER ;
  8473. SOL0= RESOU RIGT RHS ;
  8474. TABGEO.'POTENTIEL'=(ENLEVER SOL0 LX) ;
  8475. FINSI ;
  8476. *
  8477. FINPROC ;
  8478. **** A_HOMO derniere modif 10/02/92
  8479. DEBPROC A_HOMO AKN*LISTREEL RHARM*FLOTTANT RCIRC*FLOTTANT NHARM*ENTIER;
  8480. SAUTER 2 LIGNES ;
  8481. OPTION ELEM SEG2 ;
  8482. BDIP= EXTR AKN 1;BQUAD = EXTR AKN 2 ;G0 = BQUAD / RHARM ;
  8483. SAUTER 2 LIGNES ;
  8484. MESS '******************* BDIP ' BDIP ;
  8485. MESS '******************* BQUAD' BQUAD;
  8486. MESS '******************* G0 ' G0 ;
  8487. SAUTER 2 LIGNES ;
  8488. C2R = EXTR AKN 2 ;
  8489. K= 0 ;
  8490. REPETER BLOCC NHARM ;
  8491. K= K + 1; COK = EXTR AKN K ;
  8492. AKM= COK / ( RHARM ** (K - 1)) ;
  8493. CQUA= COK / C2R ;
  8494. CDIP = COK / BDIP;
  8495. MESS K AKM CQUA ;
  8496. FIN BLOCC ;
  8497. SAUTER 2 LIGNES ;
  8498. * ON CONSTRUIT UN CHPO SUR LE RAYON ANALYSE CE QUI SERA PRATIQUE POUR
  8499. * TRACER DES EVOLUTIONS ;
  8500. OP = RCIRC 0.;OO= 0. 0. ;
  8501. LSUP= D 10 OO OP;
  8502. NN= 11 ;
  8503. DX =2.;
  8504. X= -2. ;
  8505. IP=0 ;
  8506. REPETER BLOCA 11 ;
  8507. IP= IP + 1 ;
  8508. X =X + DX ; Z = X / RHARM ;
  8509. B = 0 ; G = G0 ; BQUAD = C2R * Z ;
  8510. K= 0 ;
  8511. REPETER BLOCB NHARM ;
  8512. K= K + 1 ; COK = EXTR AKN K ;
  8513. SI ( K EGA 1 ) ; B = B + COK ;SINON ;TERM= COK * ( Z ** (K - 1 ));
  8514. B= B + TERM ;
  8515. SI ( (K >EG 3 ) ET ( (ABS X ) >EG 1.E-4 ) );
  8516. G = G + (( TERM / X ) * (K - 1)) ;
  8517. FINSI ;
  8518. FINSI ;
  8519. FIN BLOCB ;
  8520. * SI (( ABS X ) >EG 1.E-4 ) ;
  8521. HQUAD= (B - BDIP - BQUAD ) /C2R ;
  8522. GQUAD= (G - G0 ) / G0 ;
  8523. HDIP = (B - BDIP) / BDIP ;
  8524. * FINSI;
  8525. SI ( IP EGA 1 ) ;
  8526. LHQ= PROG HQUAD ;LG= PROG G ;
  8527. LGQ = PROG GQUAD ; LB= PROG B;
  8528. SINON ;
  8529. LHQ= LHQ ET (PROG HQUAD ) ;LG= LG ET ( PROG G );
  8530. LGQ = LGQ ET (PROG GQUAD );LB= LB ET (PROG B );
  8531. FINSI ;
  8532. FIN BLOCA ;
  8533. SAUTER 2 LIGNES ;
  8534. CX= COOR 1 LSUP ;
  8535.  
  8536. TUTU= MANU CHPO LSUP 4 'B' LB 'DB/B' LHQ 'G' LG 'DG/G' LGQ ;
  8537. SAUTER 2 LIGNES ;
  8538. MESS ' ANALYSE CONFORME A HARMBIS ';
  8539. SAUTER 2 LIGNES ;
  8540. RECAP = CX ET TUTU ;
  8541. LIST RECAP ;
  8542. FINPROC ;
  8543. *
  8544. **** INT_COMP derniere modif janvier /92
  8545. 'DEBPROC' INT_COMP GEOP*MAILLAGE CCCC*CHPOINT GEOF*MAILLAGE ;
  8546. ************************************************************************
  8547. * interpolation d une composante sur un maillage *
  8548. * TYEL TYPE D ELEMENTS *
  8549. * entree cccc chpoint original a 1 composante de support geop *
  8550. * sortie chpo de support geof *
  8551. ************************************************************************
  8552. TYT = VALE ELEM ;
  8553. SI ( NON ( EGA TYT 'TRI3'));
  8554. GEOP = CHAN GEOP TRI3 ;
  8555. MESS 'ON PASSE EN TRI3 POUR UTLISER PROI ( DEGUEULASSE EN TRI6....)';
  8556. FINSI ;
  8557.  
  8558. OBS1 = AFFECT GEOP ( MODELE STANDARD ) TRI3 ;
  8559. CEL1 = PRCH CCCC OBS1 'NOEUD' ;
  8560. CRES = PROI GEOF CEL1 ;
  8561. FINPROC CRES ;
  8562. *
  8563. **** IDE_ELE derniere modif fevrier/92
  8564. DEBPROC IDE_ELE ;
  8565. **********************************************************************
  8566. * IDENTIFICATION DU TYPE D ELEMENTS UTILISES
  8567. **********************************************************************
  8568. TIDIM = VALE DIME ;
  8569. TVAL = VALE ELEM ;
  8570. SI ( EGA TIDIM 2 ) ;
  8571. SI (( EGA TVAL 'QUA8') 'OU' (EGA TVAL 'TRI6')) ;
  8572. TYEL = TEXTE 'QUA8' 'TRI6' ;
  8573. SINON ;
  8574. TYEL = TEXTE 'QUA4' 'TRI3' ;
  8575. FINSI ;
  8576. SINON ;
  8577. SI (( EGA TVAL 'CU20') 'OU' (EGA TVAL 'PRI16')) ;
  8578. TYEL = TEXTE 'CU20' 'PR15' 'TET10';
  8579. SINON ;
  8580. TYEL = TEXTE 'CUB8' 'PRI6' 'TET4';
  8581. FINSI ;
  8582. FINSI ;
  8583. FINPROC TYEL ;
  8584. **** MUAXI2 MODIFIE FEVRIER 92
  8585. DEBPROC MUAXI2 GEO*MAILLAGE MU*FLOTTANT IDI*ENTIER ;
  8586. ***********************************************************************
  8587. * SORTIE De CONDUCTIBILITE = 1/(MU*R) EN AXISYMETRIQUE *
  8588. * IDI = 1 sortie chamelem 'caracteristique au noeuds DEFAUT*
  8589. * IDI = 2 sortie chpo aux noeuds scalaire *
  8590. * IDI = 3 sortie chamelem au CDG *
  8591. * MODIFIEE FEVRIER 92 POUR P2 *
  8592. ***********************************************************************
  8593. IMET = 2 ;
  8594. SI ( EGA IMET 1 ) ;
  8595. * estimation de mu au noeuds en trichant sur l axe
  8596. RGEO = COOR 1 GEO ;
  8597. AXE= GEO POINTS DROITE (0. 0) (0. 10.) .05 ;
  8598. MUPO = (((RGEO + ((COOR 1 AXE) + 1.E-8)) ** -1. ) / MU ) NOMC 'K';
  8599. MATT= CHAMELEM GEO MUPO 'CARACTERISTIQUE' ;
  8600. FINSI ;
  8601. SI ( EGA IMET 2 ) ;
  8602. * estimation de mu aux cdg sans tricher sur l axe
  8603. OBMOD = MODE GEO THERMIQUE ISOTROPE ;
  8604. cp_rpoa = (coor 1 GEO ) ;
  8605. * chamelem des rayons aux cdg
  8606. ce_rpoa = CHAN 'CHAM' CP_RPOA OBMOD 'GRAVITE';
  8607. * chamelem des cdg reportes aux noeuds
  8608. RGEO = (CHAN CHPO OBMOD (CHAN 'NOEUD' OBMOD ce_rpoa )) ** -1.;
  8609. SI ( EGA IDI 1 ) ;
  8610. CHPMUGEO= ( (1./ MU ) * RGEO )NOMC 'K' ;
  8611. MATT= CHAMELEM GEO CHPMUGEO 'CARACTERISTIQUE' ;
  8612. * MESS ' 1/MU CHAMP ELEM TYPE CARACTERISTIQUE K ';
  8613. FINSI ;
  8614. SI (EGA IDI 2 ) ;
  8615. MESS ' 1/R AUX CDG REPORTES AUX NOEUDS SCALAIRE ';
  8616. MATT = RGEO ;
  8617. FINSI ;
  8618. SI (EGA IDI 3 ) ;
  8619. MESS ' 1/R CHAMP ELEM AUX CDG ';
  8620. MATT = CE_RPOA ;
  8621. FINSI ;
  8622. FINSI ;
  8623. FINPROC MATT ;
  8624. **** REMONT derniere modif 14 08 91
  8625. DEBPROC REMONT ETAB*TABLE POT*CHPOINT GEON*MAILLAGE FE/CHPOINT GEOMAIT*MAILLAGE ;
  8626. * POT SOLUTION
  8627. * GEON MAILLAGE AUTRE QUE LE SUPER
  8628. * GEOMAIT POINTS MAITRES
  8629. SI ( EXISTE ETAB 'SUPER' ) ;
  8630. SUPP= ETAB.'SUPER' ;
  8631. DSUP = SUPER 'DEPLA' SUPP POT ;
  8632. * ATTENTION SI IL Y AVAIT DES CHARGES DANS LE SUPER
  8633. RIGS = EXTRAI SUPP 'RIGT' ;
  8634. SI ( EXISTE FE ) ;
  8635. SOLSUP = RESOU RIGS ( DSUP ET FE ) ;
  8636. SINON ;
  8637.  
  8638. SOLSUP = RESOU RIGS DSUP ;
  8639. FINSI ;
  8640. GEOSUP = EXTR SOLSUP MAILLAGE 'NOMU' ;
  8641. SINON ;
  8642. ********************************************************
  8643. * autre methode eventuelle
  8644. ********************************************************
  8645. * TAIR2 = REDU SOL1 CAIR1 ;
  8646. * NN= CAIR1 NBNO ;CAIR1 = CHAN CAIR1 POI1 ;
  8647. * IP = 0 ;
  8648. * REPETER BBBB NN ;
  8649. * IP = IP + 1 ;PP = CAIR1 POINT IP ;
  8650. * CLIM = BLOQUER 'T' PP ; FP = DEPIMP CLIM ( EXTR TAIR2 'T' PP ) ;
  8651. * SI ( EGA IP 1 ); CLIMT = CLIM ;FPT = FP ;
  8652. * SINON ; CLIMT = CLIMT ET CLIM ; FPT = FPT ET FP ;FINSI ;
  8653. * FIN BBBB ;
  8654. * TIAIR2 = RESOU (RIGA ET CLIMT) ( FPT ET FE ) ;
  8655. FINSI ;
  8656. *
  8657. POIS= CHAN GEOSUP POI1 ;
  8658. AAA= DIFF POIS (CHAN GEOMAIT POI1 ) ;
  8659. SOLSU = REDU SOLSUP AAA ;
  8660. SOLT= ( POT + SOLSU ) ;
  8661. FINPROC SOLT ;
  8662. **** F_S2PI derniere modif 30/3/92
  8663. DEBPROC F_S2PI CHARM*MAILLAGE SCIRC*CHPOINT NN*ENTIER OO*POINT ;
  8664. VALIN = REDU SCIRC ( CHARM POINT INITIAL ) ;
  8665. VALFI = REDU SCIRC ( CHARM POINT FINAL ) ;
  8666. V1 = MAXI VALIN ;V2 = MAXI VALFI ;
  8667. K = -1 ;
  8668. SI (( V1 < V2 ) ET ( NUM NEG 1 )) ;
  8669. CHARM = INVE CHARM ;K = 1 ;
  8670. FINSI ;
  8671. 1P = CHARM POINT INITIAL ;2P = CHARM POINT FINAL ;
  8672. IP = 0 ;
  8673. REPETER BOUC (NN - 1 );
  8674. IP = IP + 1 ;
  8675. SI ( EGA IP 1 ) ;
  8676. SOL2 = (SCIRC PLUS (0. 0.)) * K ;
  8677. SINON ;
  8678. SOL2 = (SOL2 PLUS (0. 0.)) * K ;
  8679. FINSI ;
  8680. MAI2 = EXTR SOL2 MAILLAGE ;
  8681. PDOU = CHARM POINT FINAL ;
  8682. VALDOU = REDU SCIRC PDOU ;
  8683.  
  8684. MAI2 = DEPLACER MAI2 SYME DROITE OO PDOU ;
  8685. SI ( EGA IP 1 ) ;
  8686. CHARM2= ( INVE (CHARM SYME DROITE OO PDOU )) ;
  8687. SINON ;
  8688. CHARM2= ( INVE (CHARM2 SYME DROITE OO PDOU )) ;
  8689. FINSI ;
  8690. ELIM .0001 CHARM2 MAI2 ;
  8691. CONFONDRE ( CHARM POINT FINAL) ( CHARM2 POINT INITIAL ) ;
  8692. CHARM = CHARM ET CHARM2 ;
  8693. SCIRC = SCIRC + SOL2 - VALDOU ;
  8694. K = K * -1 ;
  8695. FIN BOUC ;
  8696. *
  8697. SUPO = CHARM ;
  8698. * TITRE ' SOLUTION SUR 2PI ';
  8699. * EVV1 = EVOL ROUG CHPO SCIRC 'T' CHARM ;
  8700. * titre ' evo '( dime evv1 ) 'supp ' ( supo nbno ) ;
  8701. * trac supo ;
  8702. * dess evv1 ;
  8703. FINPROC SCIRC SUPO ;
  8704. **** DDFOUR derniere modif 30/3/92
  8705. DEBPROC DDFOUR GEO*MAILLAGE CHARM*MAILLAGE NHARM*ENTIER SOL*CHPOINT RHARM*FLOTTANT ORIG/POINT LIS*LOGIQUE ;
  8706. *********************************************************************
  8707. * ANALYSE HARMONIQUE DU POTENTIEL VECTEUR
  8708. * GEO MAILLAGE SUPPORT SOLUTION GENERALE *
  8709. * CHARM ARC DE CERCLE SUR LEQUEL ON A LE POTENTIEL *
  8710. * NHARM NOMBRE D HARMONIQUES A CALCULER *
  8711. * SOL SOLUTION EN POTENTIEL *
  8712. * RHARM RAYON DE NORMALISATION *
  8713. * ORIG ORIGINE CERCLE D ANALYSE
  8714. * LIS LOGIQUE FAUX SI PAS DE LISSAGE POLYNOMIAL *
  8715. *********************************************************************
  8716. 1P = CHARM POINT INITIAL ;2P= CHARM POINT FINAL ;
  8717. SI ( EXISTE ORIG ) ;
  8718. RCIRC = NORM ( 1P MOINS ORIG ) ;
  8719. SINON ;
  8720. RCIRC = NORM 1P ;ORIG = 0. 0. ;
  8721. FINSI ;
  8722. X1 Y1 = COOR ( 1P MOINS ORIG );X2 Y2 = COOR 2P ;
  8723. PT = 2P PROJETER (( Y1 * -1. ) X1 ) DROITE ORIG 1P ;
  8724. H = NORM ( 2P MOINS PT ) ;
  8725. SI ( (X1 + X2 ) < 1.E-3 ) ;
  8726. NUM = 2 ;
  8727. MESS 'SOLUTION DONNEE SUR 180 DEGRES ' ;
  8728. SINON ;
  8729. ANG = ATG H ( NORM ( PT MOINS ORIG)) ;
  8730. NUM = ( ENTI ( 360.1 / ANG )) ;
  8731. MESS 'SOLUTION DONNEE SUR ' ANG ' DEGRES ' ;
  8732. FINSI ;
  8733. SI ( NON ( LIS )) ;
  8734. SCIRC = INT_COMP GEO SOL CHARM ;
  8735. SCIRC = SCIRC NOMC 'T' ;
  8736. SINON ;
  8737. * lissage polynomial
  8738. CHLI = LISS GEO CHARM SOL 2 PLAN ;
  8739. SCIRC = (EXCO CHLI 'A' ) NOMC 'T' ;
  8740. FINSI ;
  8741. RRAP = RHARM / RCIRC ;
  8742. CQTT RTOT = F_S2PI CHARM SCIRC NUM ORIG ;
  8743. EQTT = EVOL ROUG CHPO CQTT 'T' RTOT ;
  8744. AAAA= EXTR EQTT 'ABSC' ;
  8745. * QTOT= EXTR EQTT 'ORDO' ;
  8746. * LIST QTOT ;
  8747. * NI1= (DIME AAAA ) - 1 ;
  8748. * IVAL = VALE ELEM ;
  8749. * OPTION ELEM SEG2 ;I1 = 0. 0. ; I2 = 360. 0. ;
  8750. * RTOT = DROI NI1 I1 I2 ;
  8751. OBA_RMA= AFFECTE RTOT (MODELE STANDARD) COQ2;
  8752. PERIOD= MAXI AAAA ;
  8753. MULT= 360. / PERIOD ;
  8754. ANGVEC= AAAA * MULT ;
  8755. * MESS ' PERIODE ' PERIOD ;
  8756. N=0;
  8757. MESS ' ANALYSE CONFORME A POISSON HARMON ';
  8758. MESS ' HARMONIQUE POTENTIEL CHAMP ';
  8759. MESS ' NOMBRE DE SEGMENTS DE DR ' NI1 ;
  8760. MESS ' DIME DE ANGVEC ' ( DIME ANGVEC ) ;
  8761. CHPA= MANU CHPO RTOT 1 SCAL ANGVEC ;
  8762. * CQTT = MANU CHPO RTOT 1 'POT' QTOT ;
  8763. REPETER BLOCIT NHARM ;
  8764. N= N + 1 ;
  8765. RAN= RRAP ** N ;
  8766. ANGLEN= CHPA * N ;
  8767. CNX= COS ANGLEN ;
  8768. SNX= SIN ANGLEN ;
  8769. EVREL= CQTT * CNX ;EVIMA= CQTT * SNX ;
  8770. CEVREL = PRCH EVREL OBA_RMA 'RIGIDITE' ;
  8771. CEVIMA = PRCH EVIMA OBA_RMA 'RIGIDITE' ;
  8772. AK= (( INTG CEVREL ) / PERIOD ) * 2. * RAN ;
  8773. BK= (( INTG CEVIMA ) / PERIOD ) * 2. * RAN ;
  8774. CK= (( AK * AK ) + ( BK * BK ) ) ** .5 ;
  8775. FF= ( FLOT N) / RHARM ;
  8776. AKK= AK * FF ;
  8777. BKK= BK * FF ;
  8778. CKK= CK * FF ;
  8779. SI (N EGA 1 );AKN= PROG AKK ; SINON ;AKN = AKN ET (PROG AKK ) ; FINSI ;
  8780. SAUTER 1 LIGNE ;
  8781. * MESS N AK BK CK AKK BKK CKK ;
  8782. MESS N AK BK CK ;
  8783. MESS N AKK BKK CKK ;
  8784. FIN BLOCIT ;
  8785. * OPTION ELEM IVAL ;
  8786. FINPROC AKN ANGVEC ;
  8787. *****
  8788.  
  8789. **** @DEFMAT
  8790. DEBPROC @DEFMAT TAB1*TABLE ;
  8791. *23456789012345678901234567890123456789012345678901234567890123456789012
  8792. * 1 2 3 4 5 6 7
  8793. ************************************************************************
  8794. MESS '---------------------------------> Entree dans DEFMAT ' ;
  8795.  
  8796. * on initialise des evol nuls
  8797. EVMA1 = EVOL MANU ( PROG 0. 500.) ( PROG 0. 0. ) ;
  8798. EVMA2 = EVOL MANU ( PROG 0. 500.) ( PROG 0. 0. ) ;
  8799. EVMA3 = EVOL MANU ( PROG 0. 500.) ( PROG 0. 0. ) ;
  8800. EVMA4 = EVOL MANU ( PROG 0. 500.) ( PROG 0. 0. ) ;
  8801. EVMA5 = EVOL MANU ( PROG 0. 500.) ( PROG 0. 0. ) ;
  8802. CHP_TM1 = TAB1.>CHP_TM1 ;
  8803. TAB1.TETMAT = TABLE ;
  8804. TAB1.MODL_MAT = TABLE ;
  8805. TAB1.MAT_MAT = TABLE ;
  8806.  
  8807. I1 = 0 ;
  8808. REPETER BOMA11 ;
  8809. I1 = I1 + 1 ;
  8810. *>1
  8811. SI ( EXISTE (TAB1.ZONE_MAT) I1 ) ;
  8812. NOM_MAT1 = TAB1.NOM_MAT.I1 ;
  8813. MESS '>>>> MATERIAU ' I1 NOM_MAT1 ;
  8814. TMECA_I1 = TEXT TAB1.TEXTMECA.I1 ;
  8815. MO1 = MODE TAB1.ZONE_MAT.I1 TMECA_I1 ;
  8816. TAB1.MODL_MAT. I1 = MO1 ;
  8817. TITRE NOM_MAT1 ' YOUN MODULUS ' ;
  8818. TAB1.TETMAT.MO1 = TABLE ;
  8819.  
  8820. *>>2*************** orthotropie
  8821.  
  8822. SI ( EGA TAB1.TEXTMECA.I1 ' MECANIQUE ELASTIQUE ORTHOTROPE') ;
  8823. CHAYGI= CHAINE TAB1 . TEXTMECA .(I1 + 100) ;
  8824. MESS '>>> ORTHOTROPIE' TAB1.TEXTMECA.I1 ;
  8825. MESS '>>> DIRECTIONS D ORTHOTROPIE' CHAYGI ;
  8826.  
  8827. * P1 = TAB1.DIRECT1 ;
  8828. * P2 = TAB1.DIRECT2 ;
  8829. * CHAYGI = 'DIRECTION P1 P2 ' ;
  8830. * CHADIR = 'DIRECTION TAB1.DIRECT1 TAB1.DIRECT2' ;
  8831.  
  8832. SI ( NON ( EXISTE TAB1 'MOMATR')) ;
  8833. TAB1.'MOMATR' = TABLE ;
  8834. FINSI ;
  8835. TAB1.'MOMATR'.MO1 = TAB1.TEXTMECA.(I1 + 100) ;
  8836.  
  8837. * CHAYG1 = CHAINE CHADIR ' YG1 ' ;
  8838. * CHAYG2 = CHAINE CHADIR ' YG2 ' ;
  8839. * CHAYG3 = CHAINE CHADIR ' YG3 ' ;
  8840. * CHAG12 = CHAINE CHADIR ' G12 ' ;
  8841. * CHAG23 = CHAINE CHADIR ' G23 ' ;
  8842. * CHAG13 = CHAINE CHADIR ' G13 ' ;
  8843. * CHANU12 = CHAINE CHADIR ' NU12 ' ;
  8844. * CHANU23 = CHAINE CHADIR ' NU23 ' ;
  8845. * CHANU13 = CHAINE CHADIR ' NU13 ' ;
  8846. * CHAALP12 = CHAINE CHADIR ' ALP1 ' ;
  8847. * CHAALP23 = CHAINE CHADIR ' ALP2 ' ;
  8848. * CHAALP13 = CHAINE CHADIR ' ALP3 ' ;
  8849.  
  8850. *>>3*************** orthotropie 333333333333333DDDDDDDDDD
  8851.  
  8852. SI (EGA (VALEUR DIMENSION) 3 ) ;
  8853. TAB1.TETMAT.MO1.YG1 = @EVMAT TAB1.NOM_MAT.I1 'YG1' TAB1 ;
  8854. TAB1.TETMAT.MO1.YG2 = @EVMAT TAB1.NOM_MAT.I1 'YG2' TAB1 ;
  8855. TAB1.TETMAT.MO1.YG3 = @EVMAT TAB1.NOM_MAT.I1 'YG3' TAB1 ;
  8856. EVMA1 = EVMA1 ET TAB1.TETMAT.MO1.YG1 ET TAB1.TETMAT.MO1.YG2 ET TAB1.TETMAT.MO1.YG3 ;
  8857. TITRE NOM_MAT1 ' POISSON COEFFICIENT ' ;
  8858. TAB1.TETMAT.MO1.NU12 = @EVMAT TAB1.NOM_MAT.I1 'NU12' TAB1 ;
  8859. TAB1.TETMAT.MO1.NU23 = @EVMAT TAB1.NOM_MAT.I1 'NU23' TAB1 ;
  8860. TAB1.TETMAT.MO1.NU13 = @EVMAT TAB1.NOM_MAT.I1 'NU13' TAB1 ;
  8861. EVMA2 = EVMA2 ET TAB1.TETMAT.MO1.NU12 ET TAB1.TETMAT.MO1.NU23 ET TAB1.TETMAT.MO1.NU13 ;
  8862. TITRE NOM_MAT1 ' THERMAL EXPANSION ' ;
  8863. TAB1.TETMAT.MO1.ALP1 = @EVMAT TAB1.NOM_MAT.I1 'ALP1' TAB1 ;
  8864. TAB1.TETMAT.MO1.ALP2 = @EVMAT TAB1.NOM_MAT.I1 'ALP2' TAB1 ;
  8865. TAB1.TETMAT.MO1.ALP3 = @EVMAT TAB1.NOM_MAT.I1 'ALP3' TAB1 ;
  8866. EVMA3 = EVMA3 ET TAB1.TETMAT.MO1.ALP1 ET TAB1.TETMAT.MO1.ALP2 ET TAB1.TETMAT.MO1.ALP3;
  8867. TAB1.TETMAT.MO1.G12 = @EVMAT TAB1.NOM_MAT.I1 'G12' TAB1 ;
  8868. TAB1.TETMAT.MO1.G23 = @EVMAT TAB1.NOM_MAT.I1 'G23' TAB1 ;
  8869. TAB1.TETMAT.MO1.G13 = @EVMAT TAB1.NOM_MAT.I1 'G13' TAB1 ;
  8870. TM_1 = ( REDU CHP_TM1 TAB1.ZONE_MAT.I1 ) ;
  8871. *
  8872. *** DIRECTION 1
  8873. *
  8874. Y_1 = VARI TM_1 TAB1.TETMAT.MO1.YG1 YG1 ;
  8875. G_1 = VARI TM_1 TAB1.TETMAT.MO1.G12 G12 ;
  8876. N_1 = VARI TM_1 TAB1.TETMAT.MO1.NU12 NU12 ;
  8877. A_1 = VARI TM_1 TAB1.TETMAT.MO1.ALP1 ALP1 ;
  8878. *
  8879. N_1 = CHANGER CHAM N_1 MO1 'RIGIDITE' ;
  8880. Y_1 = CHANGER CHAM Y_1 MO1 'RIGIDITE' ;
  8881. G_1 = CHANGER CHAM G_1 MO1 'RIGIDITE' ;
  8882. A_1 = CHANGER CHAM A_1 MO1 'RIGIDITE' ;
  8883. *
  8884. *** DIRECTION 2
  8885. *
  8886. Y_2 = VARI TM_1 TAB1.TETMAT.MO1.YG2 YG2 ;
  8887. G_2 = VARI TM_1 TAB1.TETMAT.MO1.G23 G23 ;
  8888. N_2 = VARI TM_1 TAB1.TETMAT.MO1.NU23 NU23 ;
  8889. A_2 = VARI TM_1 TAB1.TETMAT.MO1.ALP2 ALP2 ;
  8890. *
  8891. N_2 = CHANGER CHAM N_2 MO1 'RIGIDITE' ;
  8892. Y_2 = CHANGER CHAM Y_2 MO1 'RIGIDITE' ;
  8893. G_2 = CHANGER CHAM G_2 MO1 'RIGIDITE' ;
  8894. A_2 = CHANGER CHAM A_2 MO1 'RIGIDITE' ;
  8895. *
  8896. *** DIRECTION 3
  8897. *
  8898. Y_3 = VARI TM_1 TAB1.TETMAT.MO1.YG3 YG3 ;
  8899. G_3 = VARI TM_1 TAB1.TETMAT.MO1.G13 G13 ;
  8900. N_3 = VARI TM_1 TAB1.TETMAT.MO1.NU13 NU13 ;
  8901. A_3 = VARI TM_1 TAB1.TETMAT.MO1.ALP3 ALP3 ;
  8902. *
  8903. N_3 = CHANGER CHAM N_3 MO1 'RIGIDITE' ;
  8904. Y_3 = CHANGER CHAM Y_3 MO1 'RIGIDITE' ;
  8905. G_3 = CHANGER CHAM G_3 MO1 'RIGIDITE' ;
  8906. A_3 = CHANGER CHAM A_3 MO1 'RIGIDITE' ;
  8907. *
  8908. TEX1 = TEXT CHAYGI ' YG1 Y_1 YG2 Y_2 YG3 Y_3' ;
  8909. TEX2 = TEXT CHAYGI ' G12 G_1 G23 G_2 G13 G_3' ;
  8910. TEX3 = TEXT CHAYGI ' NU12 N_1 NU23 N_2 NU13 N_3' ;
  8911. TEX4 = TEXT CHAYGI ' ALP1 A_1 ALP2 A_2 ALP3 A_3' ;
  8912. SINON ;
  8913.  
  8914. *>>3*************** orthotropie 222222222222222 DDDDDDDDDD
  8915.  
  8916. TAB1.TETMAT.MO1.YG1 = @EVMAT TAB1.NOM_MAT.I1 'YG1' TAB1 ;
  8917. TAB1.TETMAT.MO1.YG2 = @EVMAT TAB1.NOM_MAT.I1 'YG2' TAB1 ;
  8918. EVMA1 = EVMA1 ET TAB1.TETMAT.MO1.YG1 ET TAB1.TETMAT.MO1.YG2 ;
  8919.  
  8920. TITRE NOM_MAT1 ' POISSON COEFFICIENT ' ;
  8921. TAB1.TETMAT.MO1.NU12 = @EVMAT TAB1.NOM_MAT.I1 'NU12' TAB1 ;
  8922.  
  8923. EVMA2 = EVMA2 ET TAB1.TETMAT.MO1.NU12 ;
  8924.  
  8925. TITRE NOM_MAT1 ' THERMAL EXPANSION ' ;
  8926. TAB1.TETMAT.MO1.ALP1 = @EVMAT TAB1.NOM_MAT.I1 'ALP1' TAB1 ;
  8927. TAB1.TETMAT.MO1.ALP2 = @EVMAT TAB1.NOM_MAT.I1 'ALP2' TAB1 ;
  8928. EVMA3 = EVMA3 ET TAB1.TETMAT.MO1.ALP1 ET TAB1.TETMAT.MO1.ALP2 ;
  8929. TAB1.TETMAT.MO1.G12 = @EVMAT TAB1.NOM_MAT.I1 'G12' TAB1 ;
  8930. TM_1 = ( REDU CHP_TM1 TAB1.ZONE_MAT.I1 ) ;
  8931. *
  8932. *** DIRECTION 1
  8933. *
  8934. Y_1 = VARI TM_1 TAB1.TETMAT.MO1.YG1 YG1 ;
  8935. G_1 = VARI TM_1 TAB1.TETMAT.MO1.G12 G12 ;
  8936. N_1 = VARI TM_1 TAB1.TETMAT.MO1.NU12 NU12 ;
  8937. A_1 = VARI TM_1 TAB1.TETMAT.MO1.ALP1 ALP1 ;
  8938. *
  8939. N_1 = CHANGER CHAM N_1 MO1 'RIGIDITE' ;
  8940. Y_1 = CHANGER CHAM Y_1 MO1 'RIGIDITE' ;
  8941. G_1 = CHANGER CHAM G_1 MO1 'RIGIDITE' ;
  8942. A_1 = CHANGER CHAM A_1 MO1 'RIGIDITE' ;
  8943. *
  8944. *** DIRECTION 2
  8945. *
  8946. Y_2 = VARI TM_1 TAB1.TETMAT.MO1.YG2 YG2 ;
  8947. A_2 = VARI TM_1 TAB1.TETMAT.MO1.ALP2 ALP2 ;
  8948. Y_2 = CHANGER CHAM Y_2 MO1 'RIGIDITE' ;
  8949. A_2 = CHANGER CHAM A_2 MO1 'RIGIDITE' ;
  8950.  
  8951. TEX1 = TEXT CHAYGI ' YG1 Y_1 YG2 Y_2 ' ;
  8952. TEX2 = TEXT CHAYGI ' G12 G_1 ' ;
  8953. TEX3 = TEXT CHAYGI ' NU12 N_1 ' ;
  8954. TEX4 = TEXT CHAYGI ' ALP1 A_1 ALP2 A_2 ' ;
  8955. FINSI ;
  8956. ** MA1 = MATE MO1 (TEXT CHAYG1 ' Y_1 ' ) ;
  8957. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYG2 ' Y_2 ')) ;
  8958. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYG3 ' Y_3 ')) ;
  8959. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYG12 ' G_1' )) ;
  8960. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYG23 ' G_2' )) ;
  8961. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYG13 ' G_3' )) ;
  8962. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYNU12 ' N_1' )) ;
  8963. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYNU23 ' N_2' )) ;
  8964. ** MA1 = MA1 ET (MATE MO1 (TEXT CHAYNU13 ' N_3' )) ;
  8965. ;
  8966. MA1 = MATE MO1 TEX1 (TEXT TAB1 . TEXTMECA . 101 ) ;
  8967. MA2 = MATE MO1 TEX2 (TEXT TAB1 . TEXTMECA . 101 ) ;
  8968. MA3 = MATE MO1 TEX3 (TEXT TAB1 . TEXTMECA . 101 ) ;
  8969. MA4 = MATE MO1 TEX4 (TEXT TAB1 . TEXTMECA . 101 ) ;
  8970. MA1 = MA1 ET MA2 ET MA3 ET MA4 ;
  8971.  
  8972. *>>2 ************* Isotropie
  8973.  
  8974.  
  8975. SINON ;
  8976. MESS '>>> NON ORTHO' TAB1.TEXTMECA.I1 ;
  8977. TITRE NOM_MAT1 ' YOUNG MODULUS ' ;
  8978. TAB1.TETMAT.MO1.YOUN = @EVMAT TAB1.NOM_MAT.I1 'YOUN' TAB1 ;
  8979. EVMA1 = EVMA1 ET TAB1.TETMAT.MO1.YOUN ;
  8980. TITRE NOM_MAT1 ' POISSON COEFFICIENT ' ;
  8981. TAB1.TETMAT.MO1.NU = @EVMAT TAB1.NOM_MAT.I1 'NU' TAB1;
  8982. EVMA2 = EVMA2 ET TAB1.TETMAT.MO1.NU ;
  8983. TITRE NOM_MAT1 ' THERMAL EXPANSION ' ;
  8984. TAB1.TETMAT.MO1.ALPH = @EVMAT TAB1.NOM_MAT.I1 'ALPH' TAB1;
  8985. EVMA3 = EVMA3 ET TAB1.TETMAT.MO1.ALPH ;
  8986. TM_1 = ( REDU CHP_TM1 TAB1.ZONE_MAT.I1 ) ;
  8987. Y_1 = VARI TM_1 TAB1.TETMAT.MO1.YOUN YOUN ;
  8988. NU_1 = VARI TM_1 TAB1.TETMAT.MO1.NU NU ;
  8989. AL_1 = VARI TM_1 TAB1.TETMAT.MO1.ALPH ALPH ;
  8990. NU_1 = CHANGER CHAM NU_1 MO1 'RIGIDITE' ;
  8991. Y_1 = CHANGER CHAM Y_1 MO1 'RIGIDITE' ;
  8992. AL_1 = CHANGER CHAM AL_1 MO1 'RIGIDITE' ;
  8993. TEX1 = TEXTE ' YOUN Y_1 NU NU_1 ALPH AL_1 ' ;
  8994. MA1 = MATE MO1 TEX1 ;
  8995. FINSI ;
  8996. *>>2
  8997. IMOTM1 = DIME (MOTS TMECA_I1) ;
  8998. SI ( IMOTM1 EGA 5 ) ;
  8999. TITRE NOM_MAT1 ' YIELD STRESS ' ;
  9000. TAB1.TETMAT.MO1.SIGY = @EVMAT TAB1.NOM_MAT.I1 'SIGY' TAB1 ;
  9001. EVMA4 = EVMA4 ET TAB1.TETMAT.MO1.SIGY ;
  9002. TEX1 = TEXTE TEX1 ' SIGY YM_1 ' ;
  9003. TITRE NOM_MAT1 ' YIELD MODULUS' ;
  9004. YM_1 = VARI TM_1 TAB1.TETMAT.MO1.SIGY SIGY ;
  9005. YM_1 = CHANGER CHAM YM_1 MO1 'RIGIDITE' ;
  9006. TAB1.TETMAT.MO1.H = @EVMAT TAB1.NOM_MAT.I1 'H' TAB1 ;
  9007. EVMA5 = EVMA5 ET TAB1.TETMAT.MO1.H ;
  9008. H_1 = VARI TM_1 TAB1.TETMAT.MO1.H H ;
  9009. H_1 = CHANGER CHAM H_1 MO1 'RIGIDITE' ;
  9010. TEX1 = TEXTE TEX1 'H H_1 ' ;
  9011. MA1 = MATE MO1 TEX1 ;
  9012. * TEMP IMPR PLACE ;
  9013. * MENAGE ;
  9014.  
  9015. @TRCPLAS TAB1 MO1 I1 ;
  9016. TEX5 = TEXT ' MA1 = MATE MO1 ' ;
  9017. * TEX5 TEX1 TEX2 TEX3 TEX4 ;
  9018. FINSI;
  9019. *>1
  9020. SINON ;
  9021. QUITTER BOMA11 ;
  9022. FINSI ;
  9023. *>1
  9024. SI ( I1 EGA 1 ) ;
  9025. MOD_1 = MO1 ;
  9026. MAT_1 = MA1 ;
  9027. SINON ;
  9028. MOD_1 = MOD_1 ET MO1 ;
  9029. MAT_1 = MAT_1 ET MA1 ;
  9030. FINSI ;
  9031. TAB1.MAT_MAT.I1 = MA1 ;
  9032. FIN BOMA11 ;
  9033. TAB1.MATTOT = MAT_1 ;
  9034. TAB1.MODTOT = MOD_1 ;
  9035. TAC8 = TABLE ;
  9036. TAC8.1 = ' NOLI ' ;
  9037. TAC8.2 = 'MARQ PLUS REGU' ;
  9038. TAC8.3 = 'MARQ ETOI REGU' ;
  9039. TAC8.4 = 'MARQ LOSA REGU' ;
  9040. TAC8.5 = 'MARQ CARR REGU' ;
  9041. TAC8.6 = 'MARQ TRIA REGU' ;
  9042. TAC8.7 = 'MARQ TRIB REGU' ;
  9043. TAC8.8 = 'MARQ PLUS REGU' ;
  9044. TAC8.9 = 'MARQ ETOI REGU' ;
  9045. TAC8.10 = 'MARQ CROI REGU' ;
  9046. DESS EVMA1 XBOR 0. 2000. LEGE MIMA DATE TAC8 ;
  9047. DESS EVMA2 XBOR 0. 2000. LEGE MIMA DATE TAC8 ;
  9048. DESS EVMA3 XBOR 0. 2000. LEGE MIMA DATE TAC8 ;
  9049. DESS EVMA4 XBOR 0. 2000. LEGE MIMA DATE TAC8 ;
  9050. DESS EVMA5 XBOR 0. 2000. LEGE MIMA DATE TAC8 ;
  9051. MESS ' >>>>>>> fin materiaux' ;
  9052. MO1 = TAB1.MODL_MAT.1 ;
  9053. MA1 = TAB1.MAT_MAT.1 ;
  9054. CHAEPXX = MANU 'CHML' MO1 EPXX 0.001 EPYY 0. EPZZ 0. GAXY 0. GAXZ 0. GAYZ 0. TYPE 'DEFORMATIONS' 'STRESSES' ;
  9055. HO11 = HOOK MO1 MA1 ;
  9056. CHASIXX = MO1 HO11 * CHAEPXX ;
  9057. MESS ' >>>****** MAXI MINI CONT ' (MAXI CHASIXX AVEC (MOTS SMXX)) (MINI CHASIXX AVEC (MOTS SMXX));
  9058. CHAEEXX = MO1 HO11 * CHASIXX ;
  9059. MESS ' >>>****** MAXI MINI CONT ' (MAXI CHAEEXX AVEC (MOTS EPXX)) (MINI CHAEEXX AVEC (MOTS EPXX));
  9060. MESS '---------------------------------> sortie de DEFMAT';
  9061. FINPROC ;
  9062. * *
  9063. * *
  9064. * *
  9065. * *
  9066. DEBPROC DEFORAPH LIGN_1*MAILLAGE INSTEVOL*FLOTTANT MOD1*MMODEL TAB1*TABLE SM1/EVOLUTION EM1/EVOLUTION VAL1/FLOTTANT VAL2/FLOTTANT;
  9067.  
  9068. MESS '-----------------------------------> entree dans DEFORAPH ' ;
  9069. *
  9070. * !!! NON ENCORE OPERATIONNEL !!!
  9071. *
  9072. MESS ' !!! NON ENCORE OPERATIONNEL !!! ' ;
  9073.  
  9074. DIM1 = VALEUR DIME ;
  9075.  
  9076. * test sur la dimension
  9077. SI (EGA DIM1 2);
  9078. MESS ' attention contraph ne tourne pas en 3D';
  9079. QUITTER CONTRAPH ;
  9080. * malgre le probleme de PROI en 3D, qui n a pas ete regle
  9081. * mais qu on accepte faute de mieux
  9082. FINSI;
  9083.  
  9084.  
  9085. SI (NON (EXISTE TAB1 RESUCONT)) ;
  9086. MESS ' TAB1 NE CONTIENT PAS DE CONTRAINTES ' ;
  9087. MESS ' SORTIE DE CONTRAPH ' ;
  9088. QUITTER CONTRAPH ;
  9089. FINSI ;
  9090.  
  9091. * test sur la dimension de LIGN_1*MAILLAGE : a faire
  9092.  
  9093. LCONFON = FAUX ;
  9094. MAIL_1 = MOD1 EXTR 'MAIL' ;
  9095. N_1 = NBNO MAIL_1 ;
  9096. N_2 = NBNO (MAIL_1 ET LIGN_1 ) ;
  9097.  
  9098. SI ( EGA N_1 N_2 ) ;
  9099. LCONFON = VRAI ;
  9100. FINSI ;
  9101.  
  9102. SI (NON(EXISTE TAB1 TETMAT)) ;
  9103. MESS ' TAB1 NE CONTIENT PAS DE TETMAT ' ;
  9104. MESS ' SORTIE DE CONTRAPH ' ;
  9105. QUITTER CONTRAPH ;
  9106. FINSI ;
  9107.  
  9108. SI (NON(EXISTE (TAB1.TETMAT) MOD1)) ;
  9109. MESS ' TAB1.TETMAT NE CONTIENT PAS DE MODELE ' ;
  9110. MESS ' SORTIE DE CONTRAPH ' ;
  9111. QUITTER CONTRAPH ;
  9112. FINSI ;
  9113.  
  9114. SI (NON(EXISTE (TAB1.TETMAT.MOD1) SIGY)) ;
  9115. MESS ' LE MATERIAU DEMANDE N EST PAS PLASTIQUE ' ;
  9116. MESS ' SORTIE DE CONTRAPH ' ;
  9117. QUITTER CONTRAPH ;
  9118. FINSI ;
  9119.  
  9120. TITR ' DEPOUILLEMENT LE LONG DE LA LIGNE ' ;
  9121. *
  9122. * --- Depouillement en deformation
  9123. *
  9124. DEPL1 = TAB1.RESUDEPL.INSTEVOL ;
  9125. TOTA1 = EPSI MOD1 (REDU DEPL1 (EXTR MOD1 MAIL)) ;
  9126. PLAS1 = EXCO ( TAB1.RESUVARI. INSTEVOL) EPSE ;
  9127.  
  9128. * --- METHODE 1
  9129. * evaluation de la deformation ELASTIQUE PAR ELAS
  9130. * caract pris contant egal a sa moyenne sur l'intervalle de T considere
  9131. * deduction de EPStherm
  9132. CONT1 = REDU (TAB1.RESUCONT.INSTEVOL) MOD1 ;
  9133. ELAS1_1 = ELAS MOD1 CONT1 (TAB1.MAT_MAT.3) ;
  9134.  
  9135.  
  9136.  
  9137. * --- METHODE 2
  9138. * evaluation de la deformation du a la thermique
  9139. * alpha pris contant egal a sa moyenne sur l'intervalle de T considere
  9140. * deduction de EPS elas
  9141. ID1 = INDE (TAB1.'CHPOTHETA') ;
  9142. CHT1 = TAB1.CHPOTHETA . INSTEVOL - (TAB1.CHPOTHETA. (ID1 . 1)) ;
  9143. CHT2 = (TAB1.CHPOTHETA. (ID1 . 1)) + (CHT1 / 2.) ;
  9144. ALPHA1 = VARI CHT2 TAB1.TETMAT.MOD1.'ALPH' ;
  9145. THER2_1 = ALPHA1 * (EXCO CHT1 'T') ;
  9146. THER2_2 = (CHAN CHAM THER2_1 (EXTR MOD1 MAIL) NOEUD) * -1. ;
  9147. THER2_2 = (CHAN CHAM THER2_1 (EXTR MOD1 MAIL) NOEUD) ;
  9148.  
  9149.  
  9150.  
  9151. * evaluation de la limite elastique exprimee en epsilon
  9152. * cette limite est egale a Re/E c'est a dire SIGY / YOUN en langage CASTEM
  9153. * le tout dependant de la temperature du point considere
  9154.  
  9155. CHYOUN1 = VARI TAB1.CHPOTHETA.INSTEVOL TAB1.TETMAT.MOD1.'YOUN' ;
  9156. CHSIGY1 = VARI TAB1.CHPOTHETA.INSTEVOL TAB1.TETMAT.MOD1.'SIGY' ;
  9157.  
  9158. CHYOUN2 = CHYOUN1 ** (-1) ;
  9159. CHSIGY2 = CHAN CHAM CHSIGY1 (EXTR MOD1 MAIL) NOEUD ;
  9160.  
  9161. CHYOUN3 = CHAN CHAM CHYOUN2 (EXTR MOD1 MAIL) NOEUD ;
  9162. CHSIGY3 = CHSIGY2 ;
  9163.  
  9164. LIMELAS1 = CHSIGY3 * CHYOUN3 ;
  9165.  
  9166.  
  9167. SI LCONFON ;
  9168. TOTA2 = CHAN 'CHPO' MOD1 TOTA1 ;
  9169. PLAS2 = CHAN 'CHPO' MOD1 (REDU PLAS1 MOD1) ;
  9170. LIMELAS2 = CHAN 'CHPO' MOD1 LIMELAS1 ;
  9171. THER2_3 = CHAN 'CHPO' MOD1 THER2_2;
  9172. ELAS1_2 = CHAN 'CHPO' MOD1 ELAS1_1 ;
  9173. SI (EXISTE EM1 ) ;
  9174. FINSI ;
  9175. SINON ;
  9176. TOTA2 = PROI LIGN_1 (CHAN NOEUD MOD1 TOTA1) ;
  9177. PLAS2 = PROI LIGN_1 (CHAN NOEUD MOD1 (REDU PLAS1 MOD1)) ;
  9178. LIMELAS2 = PROI LIGN_1 LIMELAS1 ;
  9179. ELAS1_2 = PROI LIGN_1 (CHAN NOEUD MOD1 ELAS1_1) ;
  9180. THER2_3 = PROI LIGN_1 THER2_2;
  9181. SI (EXISTE EM1) ;
  9182. FINSI ;
  9183. FINSI ;
  9184.  
  9185.  
  9186.  
  9187. SI (EGA DIM1 2) ;
  9188. EXX1 = EXCO EPSETOT2 EPXX ;
  9189. EYY1 = EXCO EPSETOT2 EPYY ;
  9190. GXY1 = EXCO EPSETOT2 GAXY ;
  9191. EPSETOT2 = ((2. ** .5 ) / 3.) * (( ((EXX1 - EYY1 ) ** 2) + 6 * ((GXY1 * 2. ) ** 2) ) ** .5);
  9192.  
  9193.  
  9194.  
  9195. SINON ;
  9196. EXX1 = EXCO TOTA2 EPXX ;
  9197. EYY1 = EXCO TOTA2 EPYY ;
  9198. EZZ1 = EXCO TOTA2 EPZZ ;
  9199. GXY1 = EXCO TOTA2 GAXY ;
  9200. GXZ1 = EXCO TOTA2 GAXZ ;
  9201. GYZ1 = EXCO TOTA2 GAYZ ;
  9202. TOTA3 = ((2. ** .5 ) / 3.) * ( ( ((EXX1 - EYY1 ) ** 2) + ((EXX1 - EZZ1 ) ** 2) + ((EYY1 - EZZ1 ) ** 2) + 6. * ( ((GXY1 / 2.) ** 2) + ((GXZ1 / 2.) ** 2) + ((GYZ1 / 2.)** 2) ) ) ** .5);
  9203. EXX1 = EXCO ELAS1_2 EPXX ;
  9204. EYY1 = EXCO ELAS1_2 EPYY ;
  9205. EZZ1 = EXCO ELAS1_2 EPZZ ;
  9206. GXY1 = EXCO ELAS1_2 GAXY ;
  9207. GXZ1 = EXCO ELAS1_2 GAXZ ;
  9208. GYZ1 = EXCO ELAS1_2 GAYZ ;
  9209. 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);
  9210.  
  9211.  
  9212. FINSI ;
  9213.  
  9214. THER1_1 = (EXCO TOTA3 SCAL) - (EXCO PLAS2 EPSE) - (EXCO ELAS1_3 SCAL) ;
  9215. ELAS2_1 = (EXCO TOTA3 SCAL) - (EXCO PLAS2 EPSE) - (EXCO THER2_3 (EXTR (EXTR THER2_3 COMP) 1)) ;
  9216.  
  9217. EVEL1 = EVOL CHPO ELAS1_3 LIGN_1 ;
  9218. EVEL2 = EVOL CHPO ELAS2_1 LIGN_1 ;
  9219. TAC1 = TABLE ;
  9220. TAC1.1 = 'MARQ LOSA REGU TITR METH1';
  9221. TAC1.3 = 'MARQ CROI REGU TITR METH2';
  9222. EVELL = EVEL1 ET EVEL2 ;
  9223. DESS EVELL LEGE TAC1 ;
  9224.  
  9225. EVET1 = EVOL CHPO THER1_1 LIGN_1 ;
  9226. EVET2 = EVOL CHPO THER2_3 LIGN_1 ;
  9227. TAC1 = TABLE ;
  9228. TAC1.1 = 'MARQ LOSA REGU TITR METH1';
  9229. TAC1.3 = 'MARQ CROI REGU TITR METH2';
  9230. EVETT = EVET1 ET EVET2 ;
  9231. DESS EVETT LEGE TAC1 ;
  9232.  
  9233.  
  9234.  
  9235. TITRE 'EPS_TOT' ;
  9236. EVTOT1 = EVOL CHPO EPSETOT2 LIGN_1 ;
  9237. TITRE 'EPS_PLAS' ;
  9238. EVPLAS1 = EVOL CHPO EPSPLAS2 LIGN_1 ;
  9239. TITRE 'EPS_THER' ;
  9240. EVTHER1 = EVOL CHPO EPSTHER3 LIGN_1 ;
  9241. TITRE 'LIM_ELAS' ;
  9242. EVLIEL1 = EVOL CHPO LIMELAS2 LIGN_1 ;
  9243.  
  9244. TAD1 = TABLE ;
  9245. TAD1.1 = CHAI 'MARQ CROI REGU TITR EPS_TOT' ;
  9246. TAD1.3 = CHAI 'MARQ ETOI REGU TITR EPS_PLAS ' ;
  9247. TAD1.5 = CHAI 'MARQ LOSA REGU TITR EPS_THER ' ;
  9248. TAD1.7 = CHAI 'MARQ TRIA REGU TITR LIM_ELAS ' ;
  9249. EVEPS1 = EVTOT1 ET EVPLAS1 ET EVTHER1 ET EVLIEL1 ;
  9250. DESS EVEPS1 LEGE MIMA TAD1 ;
  9251.  
  9252.  
  9253. MESS '-----------------------------------> sortie de DEFORAPH ' ;
  9254.  
  9255. FINPROC ;
  9256.  
  9257. **** @DEFO_EQ
  9258. DEBPROC @DEFO_EQ EPSE1*MCHAML MOD1*MMODEL ;
  9259. MESS '----------------------------> calling @DEFO_EQ';
  9260.  
  9261. EX1 = EXCO EPSE1 EPXX NOID SCAL ;
  9262. EY1 = EXCO EPSE1 EPYY NOID SCAL ;
  9263. EZ1 = EXCO EPSE1 EPZZ NOID SCAL ;
  9264. EG1 = EXCO EPSE1 GAXY NOID SCAL ;
  9265. EG2 = EXCO EPSE1 GAXZ NOID SCAL ;
  9266. EG3 = EXCO EPSE1 GAYZ NOID SCAL ;
  9267.  
  9268. TERM1 = (EX1 - EY1 ) ** 2 ;
  9269. TERM2 = (EY1 - EZ1 ) ** 2 ;
  9270. TERM3 = (EZ1 - EX1 ) ** 2 ;
  9271. TERM4 = 6. *( ((ABS (EG1/2.) ) ** 2.) + ((ABS (EG2/2.) ) ** 2.) + ((ABS (EG3/2.) ) ** 2.) );
  9272.  
  9273. EPS_ETOI = ((2. ** .5 )/3.) * ((TERM1 + TERM2 + TERM3 + TERM4 ) ** .5 );
  9274.  
  9275. * MIN1 = MINI EPS_ETOI ;
  9276. * MAX1 = MAXI EPS_ETOI ;
  9277.  
  9278. * RM 30/08/95 suppression du trace du champ
  9279. *
  9280. * SI (EGA MIN1 MAX1 1.E-6) ;
  9281. * MESS ' epsilon equivalent constant egal a ' MAX1;
  9282. * SINON ;
  9283. * TITR1 = CHAIN 'mini maxi epsilon equivalent : 'MIN1 MAX1;
  9284. * TITR TITR1 ;
  9285. * TRAC EPS_ETOI MOD1 (EXTR MOD1 'MAIL');
  9286. * FINSI ;
  9287. *
  9288. MESS '----------------------------> exiting @DEFO_EQ';
  9289. FINPROC EPS_ETOI;
  9290. **** @DEMATH1
  9291. DEBPROC @DEMATH1 TAB1*TABLE ;
  9292.  
  9293. MESS ' ';
  9294. NIVEAU = TAB1.'NIVEAU' ;
  9295. V1 = VALE DIME ;
  9296.  
  9297. * modification RMITTEAU le 6 juin 96 pour avoir les bonnes legendes
  9298. * dans lestraces
  9299. * avec la version 96
  9300.  
  9301. SI (NIVEAU >EG 4) ;
  9302. MESS '---------------------------------> calling @DEMATH1';
  9303. FINSI ;
  9304.  
  9305. TACC1 = TABLE ;
  9306. TACC1.TITRE = TABLE ;
  9307. TAB1.DEF_MO = TABLE;
  9308. IC1 = 0 ;
  9309.  
  9310. SI ( EXISTE (TAB1.ZONE_MAT) 1 ) ;
  9311. MESS '>@DEMATH1> Materiau ----> 1 ';
  9312. MESS '>@DEMATH1> Definition of the conductivity of ' TAB1.NOM_MAT.1 ;
  9313. TITRE 'MATERIAL CONDUCTIVITY OR CAPACITY' ;
  9314. TAB1.'MAILLAG1' = TAB1. ZONE_MAT.1 ;
  9315. TAB1.'MAILLAGE' = TAB1. ZONE_MAT.1 ;
  9316.  
  9317. SI ( EXISTE (TAB1.NOM_MAT) 1.1 ) ;
  9318.  
  9319. MESS '>@DEMATH1> ' TAB1.NOM_MAT.1 ' est orthotrope';
  9320. SI ( NON ( EXISTE (TAB1.NOM_MAT) 1) ) ;
  9321. TAB1. NOM_MAT . 1 = TEXT '_ORTHOTROPE' ;
  9322. FINSI ;
  9323.  
  9324. TAB1.'EVOKX1' = @EVMAT (TAB1.NOM_MAT. 1.1) 'CONDUCTIVITE' TAB1 ;
  9325. TAB1.'EVOKY1' = @EVMAT (TAB1.NOM_MAT. 1.2) 'CONDUCTIVITE' TAB1 ;
  9326. TAB1.'EVOKZ1' = @EVMAT (TAB1.NOM_MAT. 1.3) 'CONDUCTIVITE' TAB1 ;
  9327.  
  9328. TAB1.'CONDUCT1' = @EVMAT (TAB1.NOM_MAT. 1.1) 'CONDUCTIVITE' TIN TAB1;
  9329. si (ega v1 2) ;
  9330. EVMA1 = ( TAB1.'EVOKX1') ET ( TAB1.'EVOKY1') ;
  9331. IC1 = IC1 + 1;
  9332. TACC1.IC1 = 'MARQ CARR ' ;
  9333. TACC1.TITRE.IC1 = TAB1.NOM_MAT.1.1 ;
  9334. IC1 = IC1 + 1 ;
  9335. TACC1.IC1 = 'MARQ TRIA ' ;
  9336. TACC1.TITRE.IC1 = TAB1.NOM_MAT.1.2 ;
  9337. sinon ;
  9338. EVMA1 = ( TAB1.'EVOKX1') ET ( TAB1.'EVOKY1') ET TAB1.'EVOKZ1' ;
  9339. IC1 = IC1 + 1;
  9340. TACC1.IC1 = 'MARQ CARR ' ;
  9341. TACC1.TITRE.IC1 = TAB1.NOM_MAT.1.1 ;
  9342. IC1 = IC1 + 1 ;
  9343. TACC1.IC1 = 'MARQ TRIA ' ;
  9344. TACC1.TITRE.IC1 = TAB1.NOM_MAT.1.2 ;
  9345. IC1 = IC1 + 1 ;
  9346. TACC1.IC1 = 'MARQ TRIA ' ;
  9347. TACC1.TITRE.IC1 = TAB1.NOM_MAT.1.3 ;
  9348.  
  9349. finsi ;
  9350. TAB1.DEF_MO.1 = MODE TAB1.ZONE_MAT.1 'THERMIQUE' 'ORTHOTROPE' ;
  9351.  
  9352. SINON ;
  9353. MESS '>@DEMATH1> ' TAB1.NOM_MAT.1 ' est isotrope';
  9354. TAB1.'EVOCON1' = @EVMAT (TAB1.NOM_MAT.1) 'CONDUCTIVITE' TAB1;
  9355. TAB1.'CONDUCT1' = @EVMAT (TAB1.NOM_MAT.1) 'CONDUCTIVITE' TIN TAB1;
  9356. TAB1.'EVOCOND' = @EVMAT (TAB1.NOM_MAT.1) 'CONDUCTIVITE' TAB1 ;
  9357. EVMA1 = TAB1.'EVOCON1' ;
  9358. TAB1.DEF_MO.1 = MODE TAB1.ZONE_MAT.1 'THERMIQUE' 'ISOTROPE' ;
  9359. IC1 = IC1 + 1 ;
  9360. TACC1.IC1 = 'MARQ TRIA ' ;
  9361. TACC1.TITRE.IC1 = TAB1.NOM_MAT.1;
  9362. MESS TACC1.IC1 ;
  9363. FINSI ;
  9364. SI ( TAB1.TRANSITOIRE ) ;
  9365. MESS '>@DEMATH1> Definition of the capacity of ' TAB1.NOM_MAT.1 ;
  9366. TAB1.'EVOCAPA' = @EVMAT (TAB1. NOM_MAT.1) 'CAPACITE' TAB1;
  9367. EVCA1 = TAB1.'EVOCAPA' ;
  9368. FINSI ;
  9369. FINSI ;
  9370. SI ( EXISTE (TAB1.ZONE_MAT) 2 ) ;
  9371. MESS '>@DEMATH1> Materiau ----> 2 ';
  9372. MESS '>@DEMATH1> Definition of the conductivity of ' TAB1.NOM_MAT.2 ;
  9373. TAB1.'MAILLAG2' = TAB1. ZONE_MAT.2 ;
  9374. * TAB1.'EVOCON2' = @EVMAT (TAB1. NOM_MAT.2) 'CONDUCTIVITE' TAB1 ;
  9375. * TAB1.'CONDUCT2' = @EVMAT (TAB1. NOM_MAT.2) 'CONDUCTIVITE' TIN TAB1 ;
  9376. * EVMA1 = EVMA1 ET ( TAB1.'EVOCON2') ;
  9377. * IC1 = IC1 + 1 ;
  9378. * TACC1.IC1 = ET 'MARQ CARR TITRE ' TAB1.NOM_MAT.2;
  9379. * TAB1.DEF_MO.2 = MODE TAB1.ZONE_MAT.2 'THERMIQUE' 'ISOTROPE' ;
  9380. *> js 050296
  9381. SI ( EXISTE (TAB1.NOM_MAT) 2.1 ) ;
  9382. MESS '>@DEMATH1> ' TAB1.NOM_MAT.2 ' est orthotrope';
  9383. SI ( NON ( EXISTE (TAB1.NOM_MAT) 2) ) ;
  9384. TAB1. NOM_MAT . 2 = TEXT '_ORTHOTROPE' ;
  9385. FINSI ;
  9386. TAB1.'EVOKX2' = @EVMAT (TAB1.NOM_MAT. 2.1) 'CONDUCTIVITE' TAB1 ;
  9387. TAB1.'EVOKY2' = @EVMAT (TAB1.NOM_MAT. 2.2) 'CONDUCTIVITE' TAB1 ;
  9388. TAB1.'EVOKZ2' = @EVMAT (TAB1.NOM_MAT. 2.3) 'CONDUCTIVITE' TAB1 ;
  9389. TAB1.'CONDUCT2' =@EVMAT (TAB1.NOM_MAT. 2.1) 'CONDUCTIVITE' TIN TAB1;
  9390. EVMA1 = EVMA1 ET ( TAB1.'EVOKX2') ET ( TAB1.'EVOKY2');
  9391. IC1 = IC1 + 1;
  9392. TACC1.IC1 = 'MARQ CROI ' ;
  9393. TACC1.TITRE.IC1 = (TAB1.NOM_MAT.2.1);
  9394. * MESS TACC1.IC1 ;
  9395. IC1 = IC1 + 1 ;
  9396. TACC1.IC1 = 'MARQ TRIA ' ;
  9397. TACC1.TITRE.IC1 = (TAB1.NOM_MAT.2.2);
  9398. * MESS TACC1.IC1 ;
  9399. TAB1.DEF_MO.2 = MODE TAB1.ZONE_MAT.2 'THERMIQUE' 'ORTHOTROPE' ;
  9400. SINON ;
  9401. TAB1.'EVOCON2' = @EVMAT (TAB1.NOM_MAT.2) 'CONDUCTIVITE' TAB1;
  9402. TAB1.'CONDUCT2' = @EVMAT (TAB1.NOM_MAT.2) 'CONDUCTIVITE' TIN TAB1;
  9403. TAB1.'EVOCON2' = @EVMAT (TAB1.NOM_MAT.2) 'CONDUCTIVITE' TAB1 ;
  9404. EVMA1 = EVMA1 ET TAB1.'EVOCON2' ;
  9405. TAB1.DEF_MO.2 = MODE TAB1.ZONE_MAT.2 'THERMIQUE' 'ISOTROPE' ;
  9406. IC1 = IC1 + 1 ;
  9407. TACC1.IC1 = 'MARQ TRIB ' ;
  9408. TACC1.TITRE.IC1 = (TAB1.NOM_MAT.2);
  9409. * MESS TACC1.IC1 ;
  9410. FINSI ;
  9411. *>
  9412. SI ( TAB1.TRANSITOIRE ) ;
  9413. MESS '>@DEMATH1> Definition of the capacity of ' TAB1.NOM_MAT.2 ;
  9414. TAB1.'EVOCAP2' = @EVMAT (TAB1. NOM_MAT.2) 'CAPACITE' TAB1 ;
  9415. EVCA1 = EVCA1 ET ( TAB1.'EVOCAP2') ;
  9416. FINSI ;
  9417. FINSI ;
  9418. SI ( EXISTE (TAB1.ZONE_MAT) 3 ) ;
  9419. MESS '>@DEMATH1> Materiau ----> 3 ';
  9420. MESS '>@DEMATH1> Definition of the conductivity of ' TAB1.NOM_MAT.3 ;
  9421. TAB1.'MAILLAG3' = TAB1. ZONE_MAT.3 ;
  9422. TAB1.'EVOCON3' = @EVMAT (TAB1. NOM_MAT.3) 'CONDUCTIVITE' TAB1 ;
  9423. TAB1.'CONDUCT3' = @EVMAT (TAB1. NOM_MAT.3) 'CONDUCTIVITE' TIN TAB1 ;
  9424. EVMA1 = EVMA1 ET ( TAB1.'EVOCON3') ;
  9425. IC1 = IC1 + 1 ;
  9426. TACC1.IC1 = 'MARQ ETOI ' ;
  9427. TACC1.TITRE.IC1=TAB1.NOM_MAT.3;
  9428. TAB1.DEF_MO.3 = MODE TAB1.ZONE_MAT.3 'THERMIQUE' 'ISOTROPE' ;
  9429. SI ( TAB1.TRANSITOIRE ) ;
  9430. MESS '>@DEMATH1> Definition of the capacity of ' TAB1.NOM_MAT.3 ;
  9431. TAB1.'EVOCAP3' = @EVMAT (TAB1. NOM_MAT.3) 'CAPACITE' TAB1 ;
  9432. EVCA1 = EVCA1 ET ( TAB1.'EVOCAP3') ;
  9433. FINSI ;
  9434. FINSI ;
  9435. SI ( EXISTE (TAB1.ZONE_MAT) 4 ) ;
  9436. MESS '>@DEMATH1> Material ----> 4 ';
  9437. MESS '>@DEMATH1> Definition of the conductivity of ' TAB1.NOM_MAT.4 ;
  9438. TAB1.'MAILLAG4' = TAB1. ZONE_MAT.4 ;
  9439. TAB1.'EVOCON4' = @EVMAT (TAB1. NOM_MAT.4) 'CONDUCTIVITE' TAB1 ;
  9440. TAB1.'CONDUCT4' = @EVMAT (TAB1. NOM_MAT.4) 'CONDUCTIVITE' TIN TAB1 ;
  9441. EVMA1 = EVMA1 ET ( TAB1.'EVOCON4') ;
  9442. IC1 = IC1 + 1 ;
  9443. TACC1.IC1 = 'MARQ LOSA ' ;
  9444. TACC1.TITRE.IC1 = TAB1.NOM_MAT.4 ;
  9445. TAB1.DEF_MO.4 = MODE TAB1.ZONE_MAT.4 'THERMIQUE' 'ISOTROPE' ;
  9446. SI ( TAB1.TRANSITOIRE ) ;
  9447. MESS '>@DEMATH1> Definition of the capacity of ' TAB1.NOM_MAT.4 ;
  9448. TAB1.'EVOCAP4' = @EVMAT (TAB1. NOM_MAT.4) 'CAPACITE' TAB1 ;
  9449. EVCA1 = EVCA1 ET ( TAB1.'EVOCAP4') ;
  9450. FINSI ;
  9451. FINSI ;
  9452. SI (NIVEAU >EG 4) ;
  9453. MESS '---------------------------------> exiting @DEMATH1';
  9454. FINSI ;
  9455. FINPROC EVMA1 EVCA1 TACC1 ;
  9456.  
  9457.  
  9458. **** @DEMATH2
  9459. DEBPROC @DEMATH2 TAB1*TABLE ;
  9460. TAB1.TABCON = TABLE ;
  9461. IPP1 = 0 ;
  9462. REPETER BOUCM7 ;
  9463. IPP1 = IPP1 + 1 ;
  9464. SI ( EXISTE (TAB1.ZONE_MAT) IPP1 ) ;
  9465. * MO_1 = MODE TAB1.ZONE_MAT.IPP1 'THERMIQUE' 'ISOTROPE';
  9466. MO_1 = TAB1.DEF_MO.IPP1 ;
  9467. TAB1.ZONE_MAT.IPP1 = EXTR 'MAIL' TAB1.DEF_MO.IPP1 ;
  9468. TAB1.TABCON.MO_1 =@EVMAT (TAB1.NOM_MAT.IPP1) 'CONDUCTIVITE' TAB1;
  9469. SINON ;
  9470. QUITTER BOUCM7 ;
  9471. FINSI ;
  9472. FIN BOUCM7 ;
  9473. FINPROC EVMA1 EVCA1 TACC1 ;
  9474.  
  9475.  
  9476. DEBPROC DEPOMIMA TAB1*TABLE ;
  9477. OPTION ECHO 1 IMPR 99 TRAC BENS ;
  9478. MOD_1 = TAB1.MODTOT ;
  9479. MAT_1 = TAB1.MATTOT ;
  9480. SI (EXISTE TAB1 L_ADEPOU ) ;
  9481. L_1 = TAB1.L_ADEPOU ;
  9482. FINSI ;
  9483. SI ( NON (EXISTE TAB1 MO_ADEPOU )) ;
  9484. MOTOT1 = MOD_1 ;
  9485. SINON ;
  9486. MOTOT1 = TAB1.MO_ADEPOU ;
  9487. FINSI ;
  9488. N_MAIL = EXTR 'MAIL' MOTOT1 ;
  9489. *SI ( NON (EXISTE TAB1 NMAIL_ADEPOU )) ;
  9490. * N_MAIL = 'MAIL TOT' ;
  9491. *SINON ;
  9492. * N_MAIL = TAB1.NMAIL_ADEPOU ;
  9493. *FINSI ;
  9494. I1 = 0 ;
  9495. MESS ' >>>>>>>> ' N_MAIL ' :' ;
  9496. MESS ' ====================================' ;
  9497. SAUT 2 LIGNE ;
  9498. MESS '******************************' ;
  9499. MESS '*** CONTRAINTES **' ;
  9500. MESS '******************************' ;
  9501. REPETER BDEPO1 ( DIME TAB1.L_CASADEPOU ) ;
  9502. I1 = I1 + 1 ;
  9503. XIT1 = EXTR I1 TAB1.L_CASADEPOU ;
  9504. VMI1 = VMIS MOD_1 TAB1.RESUCONT.XIT1 ;
  9505. SIRESU1 = TAB1.RESUCONT.XIT1 ET VMI1 ;
  9506. SIRESUA = TAB1.RESUVARI.XIT1 ET VMI1 ;
  9507. I2 = 0 ;
  9508. SAUT 2 LIGNE ;
  9509. MESS 'TIME' XIT1 ;
  9510. SAUT LIGNE ;
  9511. MESS ' MINI * MAXI';
  9512. SAUT LIGNE ;
  9513. REPETER BDEPO2 ( DIME TAB1.LM_SIGCOMP) ;
  9514. I2 = I2 + 1 ;
  9515. MOCOMP = EXTR TAB1.LM_SIGCOMP I2 ;
  9516. TMOCOMP = TEXT MOCOMP ;
  9517. SI (( EGA MOCOMP 'VMIS') OU ( EGA MOCOMP 'VONM') ) ;
  9518. MOCOMP = 'SCAL' ;
  9519. FINSI ;
  9520. SBID1 = REDU ( EXCO SIRESU1 MOCOMP ) MOTOT1 ;
  9521. MAXSB1 = ((MAXI SBID1)/1.E6) ;
  9522. MINSB1 = ((MINI SBID1)/1.E6) ;
  9523. MESS TMOCOMP ' (MPa) : ' MINSB1 ' * ' MAXSB1 ;
  9524. FIN BDEPO2 ;
  9525. SI (EXISTE TAB1 L_ADEPOU ) ;
  9526. DEPOULI L_1 'CONTRAINTES' MOD_1 TAB1.RESUCONT.XIT1 GLOBAL MASSIF ;
  9527. FINSI ;
  9528. FIN BDEPO1 ;
  9529. I3 = 0 ;
  9530. SAUT 2 LIGNE ;
  9531. MESS '******************************' ;
  9532. MESS '*** DEFORMATIONS **' ;
  9533. MESS '******************************' ;
  9534. SAUT 2 LIGNE ;
  9535. REPETER BDEPO3 ( DIME TAB1.L_CASADEPOU ) ;
  9536. I3 = I3 + 1 ;
  9537. XIT1 = EXTR I3 TAB1.L_CASADEPOU ;
  9538. DEPL_1 = TAB1.RESUDEPL.XIT1 ;
  9539. SI_1 = TAB1.RESUCONT.XIT1 ;
  9540. EPS_0 = EPSI MOD_1 DEPL_1 ;
  9541. EPS_1 = EPS_0 ET ( EXCO EPSE TAB1.RESUVARI.XIT1) ;
  9542. I4 = 0 ;
  9543. SAUT 2 LIGNE ;
  9544. MESS 'TIME' XIT1 ;
  9545. SAUT LIGNE ;
  9546. MESS ' MINI * MAXI DU MCHAM PTS GAUSS';
  9547. SAUT LIGNE ;
  9548. REPETER BDEPO4 ( DIME TAB1.LM_EPSCOMP) ;
  9549. I4 = I4 + 1 ;
  9550. MOCOMP = EXTR TAB1.LM_EPSCOMP I4 ;
  9551. TMOCOMP = TEXT MOCOMP ;
  9552. SI (( EGA MOCOMP 'EPZZ' ) ET ( EGA (VALE MODE) 'PLANCONT')) ;
  9553. EPS_2 = TAB1.RESUDEFI.XIT1 + (EPSCHL MOD_1 SI_1 (TAB1.CHPOTHETA. 0.) (TAB1.CHPOTHETA.XIT1) TAB1 ) ;
  9554. EPSB2 = REDU ( EXCO EPS_2 MOCOMP ) MOTOT1 ;
  9555. MAXEB2 = ((MAXI EPSB2) * 1.E2) ;
  9556. MINEB2 = ((MINI EPSB2) * 1.E2) ;
  9557. MESS TMOCOMP ' ( % ) : ' MINEB2 ' * ' MAXEB2 ;
  9558. SINON ;
  9559. EPSB1 = REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 ;
  9560. MAXEB1 = ((MAXI EPSB1) * 1.E2) ;
  9561. MINEB1 = ((MINI EPSB1) * 1.E2) ;
  9562. MESS TMOCOMP ' ( % ) : ' MINEB1 ' * ' MAXEB1 ;
  9563. FINSI ;
  9564. FIN BDEPO4 ;
  9565. SI (EXISTE TAB1 L_ADEPOU ) ;
  9566. DEPOULI L_1 'DEFORMATIONS' MOD_1 EPS_0 GLOBAL MASSIF ;
  9567. FINSI ;
  9568. FIN BDEPO3 ;
  9569. SAUT PAGE ;
  9570. OPTI ECHO 1 IMPR 6;
  9571. FINPROC ;
  9572. *****************************************************************
  9573. * *
  9574. * Procedure DEPOULI : trace des contraintes ou des deformations *
  9575. * le long d'un ligne quelconque *
  9576. * *
  9577. *****************************************************************
  9578. 'DEBPROC' FRENETT LIGN_1*MAILLAGE ;
  9579. MESS '----------------------> entree dans FRENETT ';
  9580. V1 = VALEUR DIME ;
  9581. SI( V1 EGA 2 ) ;
  9582. CHT CHN CHB = FRENET LIGN_1 'TRACE' ;
  9583. CHPP = CHT ET CHN ;
  9584. SINON ;
  9585. CHT CHN CHB = FRENET LIGN_1 'TRACE' (0. 0. 1000.);
  9586. CHPP = CHT ET CHN ET CHB ;
  9587. FINSI ;
  9588. MESS '----------------------> sortie de FRENETT ';
  9589. 'FINPROC' CHPP;
  9590.  
  9591.  
  9592.  
  9593. '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 ;
  9594.  
  9595. MESS '----------------------> entree dans DEPOULI';
  9596.  
  9597. TAB1 = TABLE;
  9598. TAC1 = TABLE ;
  9599.  
  9600. SI (( NON (EGA M_ELEM 'MASSIF')) ET (NON (EGA M_ELEM 'INFE')) ET (NON (EGA M_ELEM 'MOYE')) ET (NON (EGA M_ELEM 'SUPE')));
  9601. MESS '>>>DEPOULI>>>> OPTION NON PREVU :' M_ELEM ;
  9602. MESS '>>>DEPOULI>>>> ON STOPPE ICI ....' ;
  9603. ERREUR 'MAUVAIS_INDIC_ELEMENT_DANS_DEPOULI';
  9604. FINSI ;
  9605.  
  9606.  
  9607. SI (( NON (EGA M_REP2 'FIXE')) ET (NON (EGA M_REP2 'GLOBAL')) ET (NON (EGA M_REP2 'LOCAL')));
  9608. MESS '>>>DEPOULI>>>> OPTION NON PREVU :' M_REP2 ;
  9609. MESS '>>>DEPOULI>>>> ON STOPPE ICI ....' ;
  9610. ERREUR 'MAUVAIS_INDIC_REPERE_DANS_DEPOULI';
  9611. SINON;
  9612. M_REPE = M_REP2 ;
  9613. FINSI ;
  9614.  
  9615.  
  9616. SI (( NON (EGA M_IND1 'CONTRAINTES')) ET ( NON (EGA M_IND1 'DEFORMATIONS')) );
  9617. MESS '>>>DEPOULI>>>> OPTION NON PREVU :' M_IND1 ;
  9618. MESS '>>>DEPOULI>>>> ON STOPPE ICI ....' ;
  9619. ERREUR 'MAUVAIS_INDIC_DANS_DEPOULI';
  9620. FINSI ;
  9621.  
  9622. LCONFON = FAUX ;
  9623. MAIL_1 = MOD_L EXTR 'MAIL';
  9624. N_1 = NBNO MAIL_1 ;
  9625. N_2 = NBNO (MAIL_1 ET LIGN_1 );
  9626.  
  9627. SI ( EGA N_1 N_2 ) ;
  9628. LCONFON = VRAI;
  9629. FINSI ;
  9630.  
  9631. SI (EXISTE MCHA_E3);
  9632. SI (EGA M_IND1 'CONTRAINTES');
  9633. CAR1 = MCHA_E3;
  9634. FINSI ;
  9635. SI (EGA M_IND1 'DEFORMATIONS');
  9636. MCHA_EP = MCHA_E3;
  9637. FINSI ;
  9638. FINSI;
  9639.  
  9640.  
  9641. SI (EGA M_IND1 'CONTRAINTES');
  9642. MO_TI1 = MOT 'STRESSES ALONG THE LINE ' ;
  9643. FINSI ;
  9644. SI (EGA M_IND1 'DEFORMATIONS');
  9645. MO_TI1 = MOT 'STRAINS ALONG THE LINE ' ;
  9646. FINSI ;
  9647.  
  9648. SI (EGA M_REPE 'FIXE');
  9649. MO_TI2 = MOT ' (REPERE FIXE DONNE)';
  9650. SINON;
  9651. SI (EGA M_REPE 'GLOBAL');
  9652. MO_TI2 = MOT ' (REPERE GLOBAL)';
  9653. SINON;
  9654. MO_TI2 = MOT ' (REPERE LOCAL DE FRENET)';
  9655. FINSI;
  9656. FINSI;
  9657.  
  9658.  
  9659. SI(NON (EXISTE L_COQ2 ));
  9660. L_COQ1 = FAUX ;
  9661. SINON ;
  9662. L_COQ1 = L_COQ2 ;
  9663. FINSI;
  9664.  
  9665.  
  9666. SI (EGA M_REPE 'FIXE');
  9667. SI ((VALEUR DIME) EGA 3);
  9668. MCHA_E11 = RTENS MCHA_E2 MOD_L VECT1 VECT2;
  9669. MCHA_E1 = MCHA_E11;
  9670. SINON;
  9671. TYP1 = TYPE MCHA_E2; MESS TYP1;
  9672. MCHA_E11 = RTENS MCHA_E2 MOD_L VECT1;
  9673. MCHA_E1 = MCHA_E11;
  9674. FINSI;
  9675. SINON;
  9676. MCHA_E1 = MCHA_E2;
  9677. FINSI;
  9678.  
  9679.  
  9680. ***CHTT1 CHPOINT sur la ligne
  9681. ***EV_OTT evolution globale
  9682.  
  9683. CHM1 = REDU MCHA_E1 MOD_L ;
  9684. TC1 = EXTR CHM1 'COMP' ;
  9685. LIST1 = MOTS CROI TRIA PLUS LOSA CARR TRIB ETOI TRIB CARR LOSA;
  9686.  
  9687.  
  9688. SI ( (EGA M_REPE 'FIXE') OU (EGA M_REPE 'GLOBAL') );
  9689.  
  9690. SI (EGA M_IND1 'CONTRAINTES');
  9691. SI (EGA (VALEUR DIME) 2);
  9692. LIST2 = MOTS SMXX SMYY SMZZ SMXY VMIS TRES TREI TREE ;
  9693. SINON;
  9694. LIST2 = MOTS SMXX SMYY SMZZ SMXY SMXZ SMYZ VMIS TRES TREI TREE;
  9695. FINSI;
  9696. SINON;
  9697. SI (EGA (VALEUR DIME) 2);
  9698. LIST2 = MOTS EPXX EPYY EPZZ GAXY PLAS;
  9699. SINON;
  9700. LIST2 = MOTS EPXX EPYY EPZZ GAXY GAXZ GAYZ PLAS;
  9701. FINSI;
  9702. FINSI;
  9703.  
  9704. I1 = 1;
  9705. REPETER BOUC1 (DIME TC1 );
  9706. MOC1 = ( EXTR TC1 I1 );
  9707. SSI1 = EXCO MOC1 CHM1 'SCAL';
  9708. SI LCONFON;
  9709. CHI1 = CHAN 'CHPO' MOD_L ( CHAN NOEUD MOD_L SSI1 );
  9710. SINON ;
  9711. CHI1 = PROI LIGN_1 ( CHAN NOEUD MOD_L SSI1 );
  9712. FINSI;
  9713. CHI1 = NOMC MOC1 CHI1;
  9714. EV_I1 = EVOL CHPO CHI1 MOC1 LIGN_1;
  9715. TAB1.MOC1 = EV_I1;
  9716. TITRE MO_TI1 MO_TI2;
  9717. SI ( I1 EGA 1 );
  9718. MARQ1 = TEXT (EXTR 1 LIST1);
  9719. COMP1 = TEXT (EXTR 1 LIST2);
  9720. * TAC1.1 = CHAINE ' MARQ ' MARQ1 ' REGU ' ' TITR ' COMP1;
  9721. EV_OTT = EV_I1;
  9722. CHTT1 = CHI1;
  9723. SINON ;
  9724. DIM1 = DIME EV_OTT;
  9725. MARQ1 = TEXT (EXTR I1 LIST1);
  9726. COMP1 = TEXT (EXTR I1 LIST2);
  9727. * TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU ' ' TITR ' COMP1;
  9728. EV_OTT = EV_OTT ET EV_I1 ;
  9729. CHTT1 = CHTT1 ET CHI1;
  9730. FINSI ;
  9731. I1 = I1 + 1;
  9732. FIN BOUC1;
  9733. FINSI ;
  9734.  
  9735. SI (EGA M_REPE 'LOCAL');
  9736. SI (EGA M_IND1 'CONTRAINTES');
  9737. SI (EGA (VALEUR DIME) 2);
  9738. LIST2 = MOTS SMTT SMNN SMBB SMTN VMIS TRES TREI TREE;
  9739. SINON;
  9740. LIST2 = MOTS SMTT SMNN SMBB SMTN SMTB SMNB VMIS TRES TREI TREE;
  9741. FINSI;
  9742. SINON;
  9743. SI (EGA (VALEUR DIME) 2);
  9744. LIST2 = MOTS EPTT EPNN EPBB GATN PLAS;
  9745. SINON;
  9746. LIST2 = MOTS EPTT EPNN EPBB GATN GATB GANB PLAS;
  9747. FINSI;
  9748. FINSI;
  9749. I1 = 1;
  9750.  
  9751. REPETER BOUC3 (DIME TC1 );
  9752. MOC1 = ( EXTR TC1 I1 );
  9753. SSI1 = EXCO MOC1 CHM1 'SCAL';
  9754. SI LCONFON;
  9755. CHI1 = CHAN 'CHPO' MOD_L ( CHAN NOEUD MOD_L SSI1 );
  9756. SINON ;
  9757. CHI1 = PROI LIGN_1 ( CHAN NOEUD MOD_L SSI1 );
  9758. FINSI;
  9759. CHI1 = NOMC MOC1 CHI1;
  9760. TAB1.MOC1 = EV_I1;
  9761. SI ( I1 EGA 1 );
  9762. CHTT1 = CHI1;
  9763. SINON ;
  9764. CHTT1 = CHTT1 ET CHI1;
  9765. FINSI ;
  9766. I1 = I1 + 1;
  9767. FIN BOUC3;
  9768. CHPP = FRENETT LIGN_1 ;
  9769. CHTT2 = CHREP M_IND1 CHTT1 CHPP ;
  9770. TC1 = EXTR CHTT2 'COMP' ;
  9771. MENAGE ;
  9772. I1 = 1 ;
  9773. REPETER BOUC2 (DIME TC1 ) ;
  9774. MOC1 = ( EXTR TC1 I1 ) ;
  9775. EV_I1 = EVOL CHPO CHTT2 MOC1 LIGN_1 ;
  9776. TITRE MO_TI1 MO_TI2 ;
  9777. MENAGE ;
  9778. SI ( I1 EGA 1 ) ;
  9779. MARQ1 = TEXT (EXTR 1 LIST1) ;
  9780. COMP1 = TEXT (EXTR 1 LIST2) ;
  9781. * TAC1.1 = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  9782. EV_OTT = EV_I1;
  9783. SINON;
  9784. DIM1 = DIME EV_OTT;
  9785. MARQ1 = TEXT (EXTR I1 LIST1);
  9786. COMP1 = TEXT (EXTR I1 LIST2);
  9787. * TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  9788. EV_OTT = EV_OTT ET EV_I1;
  9789. FINSI;
  9790. I1 = I1 + 1;
  9791. TAB1.MOC1 = EV_I1;
  9792. FIN BOUC2;
  9793. FINSI;
  9794.  
  9795. SI (EGA M_IND1 'CONTRAINTES');
  9796.  
  9797. SI ((EGA M_ELEM 'MASSIF') OU (EGA M_ELEM 'MOYE'));
  9798.  
  9799. DIM1 = DIME EV_OTT;
  9800. MARQ1 = TEXT (EXTR I1 LIST1);
  9801. COMP1 = TEXT (EXTR I1 LIST2);
  9802. * TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  9803. I1 = I1 + 1;
  9804.  
  9805. SI (EXISTE MCHA_E3);
  9806. VMI1 = VMIS MOD_L CHM1 CAR1;
  9807. SINON ;
  9808. VMI1 = VMIS MOD_L CHM1 ;
  9809. FINSI;
  9810. SI LCONFON;
  9811. CHVM = CHAN 'CHPO' MOD_L ( CHAN NOEUD MOD_L VMI1 );
  9812. SINON ;
  9813. CHVM = PROI LIGN_1 ( CHAN NOEUD MOD_L VMI1 );
  9814. FINSI;
  9815. EVVM = EVOL ROUGE CHPO CHVM SCAL LIGN_1;
  9816. EV_OTT = EV_OTT ET EVVM ;
  9817. TAB1.VMIS = EVVM;
  9818.  
  9819. DIM1 = DIME EV_OTT;
  9820. MARQ1 = TEXT (EXTR I1 LIST1);
  9821. COMP1 = TEXT (EXTR I1 LIST2);
  9822. * TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  9823. I1 = I1 + 1;
  9824.  
  9825. SI (EXISTE MCHA_E3);
  9826. TRE1 = TRESCA MOD_L CHM1 CAR1 MOYE;
  9827. SINON ;
  9828. SI (EGA M_ELEM 'MASSIF');
  9829. TRE1 = TRESCA MOD_L CHM1 ;
  9830. SINON ;
  9831. TRE1 = TRESCA MOD_L CHM1 MOYE;
  9832. FINSI ;
  9833. FINSI;
  9834. SI LCONFON;
  9835. CHTR1 = CHAN 'CHPO' MOD_L ( CHAN NOEUD MOD_L TRE1 );
  9836. SINON ;
  9837. CHTR1 = PROI LIGN_1 ( CHAN NOEUD MOD_L TRE1 );
  9838. FINSI;
  9839. EVTR1 = EVOL VERT CHPO CHTR1 SCAL LIGN_1;
  9840. EV_OTT = EV_OTT ET EVTR1 ;
  9841. TAB1.TRES1 = EVTR1;
  9842.  
  9843. FINSI;
  9844.  
  9845.  
  9846. SI (EGA M_ELEM 'MOYE') ;
  9847.  
  9848. DIM1 = DIME EV_OTT;
  9849. MARQ1 = TEXT (EXTR I1 LIST1);
  9850. COMP1 = TEXT (EXTR I1 LIST2);
  9851. * TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  9852. I1 = I1 + 1;
  9853.  
  9854. TRE2 = TRESCA MOD_L CHM1 CAR1 INFE;
  9855. SI LCONFON;
  9856. CHTR2 = CHAN 'CHPO' MOD_L ( CHAN NOEUD MOD_L TRE2);
  9857. SINON ;
  9858. CHTR2 = PROI LIGN_1 ( CHAN NOEUD MOD_L TRE2 );
  9859. FINSI;
  9860. EVTR2 = EVOL ROUGE CHPO CHTR2 SCAL LIGN_1;
  9861. EV_OTT = EV_OTT ET EVTR2 ;
  9862. TAB1.TRES2 = EVTR2;
  9863.  
  9864.  
  9865. DIM1 = DIME EV_OTT;
  9866. MARQ1 = TEXT (EXTR I1 LIST1);
  9867. COMP1 = TEXT (EXTR I1 LIST2);
  9868. * TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  9869.  
  9870. TRE3 = TRESCA MOD_L CHM1 CAR1 SUPE;
  9871. SI LCONFON;
  9872. CHTR3 = CHAN 'CHPO' MOD_L (CHAN NOEUD MOD_L TRE3 );
  9873. SINON ;
  9874. CHTR3 = PROI LIGN_1 (CHAN NOEUD MOD_L TRE3 );
  9875. FINSI;
  9876. EVTR3 = EVOL ROSE CHPO CHTR3 SCAL LIGN_1;
  9877. EV_OTT = EV_OTT ET EVTR3 ;
  9878. TAB1.TRES = EVTR3;
  9879.  
  9880. FINSI;
  9881. FINSI;
  9882.  
  9883. SI (EGA M_IND1 'DEFORMATIONS');
  9884. SI ( EXISTE MCHA_E3 );
  9885. * I2 = I1 * 2 - 1;
  9886. * TAC1.I2 = 'MARQ ETOI TITR EPSE_PLAS';
  9887. EPSE1 = EXCO EPSE (REDU MCHA_EP MOD_L) ;
  9888. SI LCONFON;
  9889. EPSEL1 = CHAN 'CHPO' MOD_L (CHAN NOEUD MOD_L EPSE1) ;
  9890. SINON ;
  9891. EPSEL1 = PROI LIGN_1 (CHAN NOEUD MOD_L EPSE1) ;
  9892. FINSI;
  9893. EVOSE = EVOL ROUGE CHPO EPSEL1 EPSE LIGN_1 ;
  9894.  
  9895. DIM1 = DIME EV_OTT;
  9896. MARQ1 = TEXT (EXTR I1 LIST1);
  9897. COMP1 = TEXT (EXTR I1 LIST2);
  9898. * TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  9899. EV_OTT = EV_OTT ET EVOSE ;
  9900. TAB1.PLAS = EVOSE;
  9901. FINSI;
  9902. FINSI;
  9903.  
  9904.  
  9905. DESS EV_OTT TAC1 MIMA LEGE ;
  9906.  
  9907. TAB1.MARC = TAC1;
  9908. TAB1.EVOL = EV_OTT;
  9909.  
  9910. MESS '----------------------> sortie de DEPOULI ';
  9911. FINPROC TAB1;
  9912.  
  9913.  
  9914.  
  9915.  
  9916.  
  9917.  
  9918.  
  9919.  
  9920.  
  9921.  
  9922.  
  9923.  
  9924.  
  9925.  
  9926.  
  9927.  
  9928.  
  9929.  
  9930.  
  9931.  
  9932.  
  9933. 'DEBPROC' DEPT LIGN_1*MAILLAGE MOD_L*MMODEL MCHA_E2*CHPOINT;
  9934.  
  9935. MESS '----------------------> entree dans DEPT';
  9936.  
  9937. LCONFON = FAUX ;
  9938. MAIL_1 = MOD_L EXTR 'MAIL';
  9939. N_1 = NBNO MAIL_1 ;
  9940. N_2 = NBNO (MAIL_1 ET LIGN_1 );
  9941.  
  9942. SI ( EGA N_1 N_2 ) ;
  9943. LCONFON = VRAI;
  9944. FINSI ;
  9945.  
  9946. MAIL1 = (extr MOD_L 'MAIL' ) ;
  9947. LEV1 = REDU MCHA_E2 MAIL1;
  9948.  
  9949. SI LCONFON ;
  9950. LEV2 = REDU LEV1 LIGN_1 ;
  9951. LEV3 = EVOL CHPO LEV2 LIGN_1 ;
  9952. SINON ;
  9953. LEV2 = PROI (CHAN CHAM LEV1 MAIL1 NOEUD ) LIGN_1 ;
  9954. LEV3 = EVOL CHPO LEV2 LIGN_1 ;
  9955. FINSI ;
  9956.  
  9957. DESS LEV3 ;
  9958.  
  9959.  
  9960.  
  9961.  
  9962. MESS '----------------------> sortie de DEPT ';
  9963. FINPROC ;
  9964.  
  9965.  
  9966.  
  9967.  
  9968.  
  9969.  
  9970.  
  9971.  
  9972.  
  9973.  
  9974.  
  9975.  
  9976.  
  9977.  
  9978.  
  9979.  
  9980.  
  9981.  
  9982.  
  9983.  
  9984.  
  9985. **** @DESCEND
  9986.  
  9987. DEBPROC @DESCEND CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT PASB0*FLOTTANT CHSIGN0*CHPOINT TAB1*TABLE ;
  9988. *
  9989. *****************************************************
  9990. * Procedure de descente des lignes de champ par une *
  9991. * methode explicite. Alain MOAL (Fevrier 2001) *
  9992. *****************************************************
  9993. *
  9994. *MESS '---------------------------------> calling @descend';
  9995. *
  9996. *--------------- VARIABLES D'ENTREE :
  9997. MAIL0 = TAB1.<MAILLAGE_B ;
  9998. *-----------------------------------
  9999. *
  10000. *---- Calcul du champ et de sa norme
  10001. BR BZ BPHI = @MAGNB TAB1 ;
  10002. *
  10003. *---- Descente dans le plan (R,Z)
  10004. BPHI = BPHI * 0. ;
  10005. PHI = ATG (COOR 2 MAIL0) (COOR 1 MAIL0) ;
  10006. *AM*11/09/01*BX = BR * (COS PHI) + (BPHI * (SIN PHI));
  10007. *AM*11/09/01*BY = BR * (SIN PHI) - (BPHI * (COS PHI));
  10008. BX = BR * (COS PHI) - (BPHI * (SIN PHI));
  10009. BY = BR * (SIN PHI) + (BPHI * (COS PHI));
  10010. NORM_B = ((BX*BX) + (BY*BY) + (BZ*BZ))**0.5 ;
  10011. *
  10012. *---- Deplacements (methode explicite) affectes du signe
  10013. *---- donnant le sens de descente dans le plan (R,Z)
  10014. DEPX0 = CHSIGN0 * BX * PASB0 / NORM_B ;
  10015. DEPY0 = CHSIGN0 * BY * PASB0 / NORM_B ;
  10016. DEPZ0 = CHSIGN0 * BZ * PASB0 / NORM_B ;
  10017. *
  10018. *---- Nouvelles coordonnees
  10019. X_NEW = CHP_X + DEPX0 ;
  10020. Y_NEW = CHP_Y + DEPY0 ;
  10021. Z_NEW = CHP_Z + DEPZ0 ;
  10022. *
  10023. *---- actualisation de la position des points de la ligne
  10024. DEPX0 = NOMC UX DEPX0 NATURE DIFFUS ;
  10025. DEPY0 = NOMC UY DEPY0 NATURE DIFFUS ;
  10026. DEPZ0 = NOMC UZ DEPZ0 NATURE DIFFUS ;
  10027. DEP0 = DEPX0 ET DEPY0 ET DEPZ0 ;
  10028. *
  10029. *MESS '---------------------------------> exiting @descend';
  10030. FINPROC X_NEW Y_NEW Z_NEW DEP0 ;
  10031.  
  10032. **** @DEXPJET
  10033.  
  10034. DEBPROC @DEXPJET CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT PASB0*FLOTTANT TAB1*TABLE;
  10035.  
  10036. *MESS '---------------------------------> calling @DEXPJET';
  10037. *
  10038. *--------------- VARIABLES D'ENTREE :
  10039. MAIL0 = TAB1.<MAILLAGE_B ;
  10040. *-----------------------------------
  10041. *
  10042. *---- Calcul du champ et de sa norme
  10043. BR BZ BPHI = @MAGNB TAB1 ;
  10044. *
  10045. PHI = ATG (COOR 2 MAIL0) (COOR 1 MAIL0) ;
  10046. *AM*11/09/01*BX = BR * (COS PHI) + (BPHI * (SIN PHI));
  10047. *AM*11/09/01*BY = BR * (SIN PHI) - (BPHI * (COS PHI));
  10048. BX = BR * (COS PHI) - (BPHI * (SIN PHI));
  10049. BY = BR * (SIN PHI) + (BPHI * (COS PHI));
  10050. NORM_B = ((BX*BX) + (BY*BY) + (BZ*BZ))**0.5 ;
  10051. *
  10052. *---- Deplacements (methode explicite)
  10053. DEPX0 = BX * PASB0 / NORM_B ;
  10054. DEPY0 = BY * PASB0 / NORM_B ;
  10055. DEPZ0 = BZ * PASB0 / NORM_B ;
  10056.  
  10057. *MESS '---------------------------------> exiting @DEXPJET';
  10058. FINPROC DEPX0 DEPY0 DEPZ0 ;
  10059.  
  10060. **** @DEXPLI
  10061.  
  10062. DEBPROC @DEXPLI CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT PASB0*FLOTTANT TAB1*TABLE;
  10063.  
  10064. *MESS '---------------------------------> calling @DEXPLI';
  10065.  
  10066. *--------------- VARIABLES D'ENTREE :
  10067. TYPCAL = TAB1.<TYPE_CALCUL ;
  10068. *------------------------------------
  10069. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  10070. ISHIFT = VRAI ;
  10071. IRIPPLE = VRAI ;
  10072. FINSI ;
  10073. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  10074. ISHIFT = VRAI ;
  10075. IRIPPLE = FAUX ;
  10076. FINSI ;
  10077. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  10078. ISHIFT = FAUX ;
  10079. IRIPPLE = VRAI ;
  10080. FINSI ;
  10081. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  10082. ISHIFT = FAUX ;
  10083. IRIPPLE = FAUX ;
  10084. FINSI ;
  10085. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  10086. ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
  10087. FINSI ;
  10088.  
  10089. * ---- Calcul du champ dans le repere global
  10090. BXG BYG BZG FSECU = @CHAMB TAB1 CHP_X CHP_Y CHP_Z ISHIFT IRIPPLE ;
  10091.  
  10092. * ---- Calcul de la norme du champ
  10093.  
  10094. NORM_B = ((BXG*BXG) + (BYG*BYG) + (BZG*BZG))**0.5 ;
  10095.  
  10096. * ---- Calcul des deplacements
  10097.  
  10098. DEPX0 = BXG * PASB0 / NORM_B ;
  10099. DEPY0 = BYG * PASB0 / NORM_B ;
  10100. DEPZ0 = BZG * PASB0 / NORM_B ;
  10101.  
  10102. *MESS '---------------------------------> exiting @DEXPLI';
  10103. FINPROC DEPX0 DEPY0 DEPZ0 ;
  10104. **** @DMILIEU
  10105.  
  10106. DEBPROC @DMILIEU CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT PASB0*FLOTTANT CHSIGN/CHPOINT TAB1*TABLE;
  10107.  
  10108. *MESS '---------------------------------> calling @DMILIEU';
  10109.  
  10110. *--------------- VARIABLES D'ENTREE :
  10111. TYPCAL = TAB1.<TYPE_CALCUL ;
  10112. RP = TAB1.<RP ;
  10113. HP = TAB1.<HP ;
  10114. *------------------------------------
  10115. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  10116. ISHIFT = VRAI ;
  10117. IRIPPLE = VRAI ;
  10118. FINSI ;
  10119. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  10120. ISHIFT = VRAI ;
  10121. IRIPPLE = FAUX ;
  10122. FINSI ;
  10123. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  10124. ISHIFT = FAUX ;
  10125. IRIPPLE = VRAI ;
  10126. FINSI ;
  10127. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  10128. ISHIFT = FAUX ;
  10129. IRIPPLE = FAUX ;
  10130. FINSI ;
  10131. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  10132. ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
  10133. FINSI ;
  10134. *
  10135. SI (EGA (TYPE CHSIGN) MOT) ;
  10136. * --- Cas ou l'appel vient d'une proc qui n'a pas calcule CHSIGN
  10137. CHSIGN = 1. ;
  10138. FINSI ;
  10139. *BR01/10/98 SI (EXISTE TAB1 <CHSIGN) ;
  10140. * CHSIGN = TAB1.<CHSIGN ;
  10141. * --- Cas ou l'appel vient d'une proc qui n'a pas calcule TAB1.<CHSIGN
  10142. *SINON ;
  10143. * CHSIGN = 1. ;
  10144. *FINSI ;
  10145.  
  10146. * ---- Lors du premier pas, calcul des points milieux
  10147. SI (NON (EXIS TAB1 <CHP_X1)) ;
  10148.  
  10149.  
  10150. DEPX0 DEPY0 DEPZ0 = @DEXPLI CHP_X CHP_Y CHP_Z PASB0 TAB1;
  10151. CHP_X1 = CHP_X + (CHSIGN * DEPX0) ;
  10152. CHP_Y1 = CHP_Y + (CHSIGN * DEPY0) ;
  10153. CHP_Z1 = CHP_Z + (CHSIGN * DEPZ0) ;
  10154. SINON ;
  10155. CHP_X1 = TAB1.<CHP_X1 ;
  10156. CHP_Y1 = TAB1.<CHP_Y1 ;
  10157. CHP_Z1 = TAB1.<CHP_Z1 ;
  10158. MAILR = EXTR CHP_X MAIL ;
  10159. CHP_X1 = REDU CHP_X1 MAILR ;
  10160. CHP_Y1 = REDU CHP_Y1 MAILR ;
  10161. CHP_Z1 = REDU CHP_Z1 MAILR ;
  10162. FINSI ;
  10163.  
  10164. * ---- Calcul du deplacement dans le repere global
  10165. * ---- (aux points milieux)
  10166.  
  10167. DEPX0 DEPY0 DEPZ0 = @DEXPLI CHP_X1 CHP_Y1 CHP_Z1 PASB0 TAB1 ;
  10168.  
  10169. * ---- Actualisation des points initiaux
  10170.  
  10171. X_NEW = CHP_X + (CHSIGN * DEPX0) ;
  10172. Y_NEW = CHP_Y + (CHSIGN * DEPY0) ;
  10173. Z_NEW = CHP_Z + (CHSIGN * DEPZ0) ;
  10174.  
  10175.  
  10176. * ---- Calcul du deplacement aux points initiaux remontes
  10177.  
  10178.  
  10179. DEPXI DEPYI DEPZI = @DEXPLI X_NEW Y_NEW Z_NEW PASB0 TAB1;
  10180.  
  10181. * ---- Calcul des nouveaux points milieux
  10182.  
  10183. CHP_X1 = CHP_X1 + (CHSIGN * DEPXI) ;
  10184. CHP_Y1 = CHP_Y1 + (CHSIGN * DEPYI) ;
  10185. CHP_Z1 = CHP_Z1 + (CHSIGN * DEPZI) ;
  10186.  
  10187. * ---- Actualisation des points milieux
  10188.  
  10189. TAB1.<CHP_X1 = CHP_X1 ;
  10190. TAB1.<CHP_Y1 = CHP_Y1 ;
  10191. TAB1.<CHP_Z1 = CHP_Z1 ;
  10192.  
  10193. *MESS '---------------------------------> exiting @DMILIEU';
  10194. FINPROC DEPX0 DEPY0 DEPZ0 ;
  10195. **** @DMOYEN
  10196.  
  10197. DEBPROC @DMOYEN CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT PASB0*FLOTTANT CHSIGN/CHPOINT TAB1*TABLE;
  10198.  
  10199.  
  10200. *MESS '---------------------------------> calling @DMOYEN';
  10201.  
  10202. *--------------- VARIABLES D'ENTREE :
  10203. TYPCAL = TAB1.<TYPE_CALCUL ;
  10204. *------------------------------------
  10205. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  10206. ISHIFT = VRAI ;
  10207. IRIPPLE = VRAI ;
  10208. FINSI ;
  10209. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  10210. ISHIFT = VRAI ;
  10211. IRIPPLE = FAUX ;
  10212. FINSI ;
  10213. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  10214. ISHIFT = FAUX ;
  10215. IRIPPLE = VRAI ;
  10216. FINSI ;
  10217. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  10218. ISHIFT = FAUX ;
  10219. IRIPPLE = FAUX ;
  10220. FINSI ;
  10221. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  10222. ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
  10223. FINSI ;
  10224. *
  10225. SI (EGA (TYPE CHSIGN) MOT) ;
  10226. * --- Cas ou l'appel vient d'une proc qui n'a pas calcule CHSIGN
  10227. CHSIGN = 1. ;
  10228. FINSI ;
  10229.  
  10230. * ---- Calcul du champ dans le repere global
  10231. BXG BYG BZG FSECU = @CHAMB TAB1 CHP_X CHP_Y CHP_Z ISHIFT IRIPPLE ;
  10232.  
  10233. * ---- Calcul de la norme du champ
  10234.  
  10235. NORM_B = ((BXG*BXG) + (BYG*BYG) + (BZG*BZG))**0.5 ;
  10236.  
  10237. * ---- Calcul du point extremite par la methode des tangentes
  10238.  
  10239. XG_NEW0 = CHP_X + (CHSIGN * BXG * PASB0 / NORM_B) ;
  10240. YG_NEW0 = CHP_Y + (CHSIGN * BYG * PASB0 / NORM_B) ;
  10241. ZG_NEW0 = CHP_Z + (CHSIGN * BZG * PASB0 / NORM_B) ;
  10242.  
  10243.  
  10244.  
  10245. * ---- Calcul du champ magnetique dans le repere global
  10246. * ---- sur le point extremite
  10247.  
  10248.  
  10249. BXG0 BYG0 BZG0 FSECU = @CHAMB TAB1 XG_NEW0 YG_NEW0 ZG_NEW0 ISHIFT IRIPPLE ;
  10250.  
  10251.  
  10252. * ---- Moyenne des champs magnetiques
  10253.  
  10254. BXG1 = (BXG + BXG0)/2. ;
  10255. BYG1 = (BYG + BYG0)/2. ;
  10256. BZG1 = (BZG + BZG0)/2. ;
  10257.  
  10258.  
  10259. * ---- Calcul de la norme du champ moyenne
  10260.  
  10261. NORM_B1 = ((BXG1*BXG1) + (BYG1*BYG1) + (BZG1*BZG1))**0.5 ;
  10262.  
  10263. * ---- Calcul des deplacements
  10264.  
  10265. DEPX0 = BXG1 * PASB0 / NORM_B1 ;
  10266. DEPY0 = BYG1 * PASB0 / NORM_B1 ;
  10267. DEPZ0 = BZG1 * PASB0 / NORM_B1 ;
  10268.  
  10269. *MESS '---------------------------------> exiting @DMOYEN';
  10270. FINPROC DEPX0 DEPY0 DEPZ0 ;
  10271. **** @DPSI
  10272.  
  10273. DEBPROC @DPSI TAB1*TABLE ;
  10274.  
  10275. *************************************************************
  10276. * Procedure de calcul de dpsi en chaque point d'un maillage *
  10277. * donne. Alain MOAL (Novembre 2001) *
  10278. *************************************************************
  10279. *
  10280. MESS '---------------------------------> calling @DPSI';
  10281. *
  10282. *--------------- VARIABLES D'ENTREE :
  10283. CHB0 = TAB1.<CARTE_B ;
  10284. GRILB0 = TAB1.<GRILLE_B ;
  10285. MAIL1 = TAB1.<MAILLAGE_B ;
  10286. *------------------------------------
  10287. *TRAC (MAIL1 ET GRILB0) ;
  10288. CHEL1 = CHAN CHAM CHB0 GRILB0 ;
  10289. CHPO1 = PROI MAIL1 CHEL1 1.E-4;
  10290. CHDPSI = EXCO 'DPSI' CHPO1 ;
  10291. *
  10292. MESS '---------------------------------> exiting @DPSI';
  10293. FINPROC CHDPSI ;
  10294.  
  10295. **** @DREPROJ
  10296.  
  10297. DEBPROC @DREPROJ CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT PASB0*FLOTTANT CHSIGN/CHPOINT TAB1*TABLE ;
  10298.  
  10299. ****************************************************************
  10300. * Procedure de calcul du deplacement pour remonter des lignes *
  10301. * de champ magnetique, a partir des CHPOINT de coordonnees *
  10302. * methode utilisant une reprojection sur la SMF *
  10303. * ---> construit un chpoint appuye sur l'objet etudie et *
  10304. * contenant pour chaque point le deplacement sur un pas pour *
  10305. * remonter les lignes de champ *
  10306. ****************************************************************
  10307.  
  10308. *MESS '---------------------------------> calling @DREPROJ';
  10309.  
  10310. *--------------- VARIABLES D'ENTREE :
  10311. TYPCAL = TAB1.<TYPE_CALCUL ;
  10312. RR = TAB1.<RR ;
  10313. EPS0 = TAB1.<EPS ;
  10314. NBOB = TAB1.<NBOB ;
  10315. COEFA = TAB1.<COEFA ;
  10316. COEFB = TAB1.<COEFB ;
  10317. COEFC = TAB1.<COEFC ;
  10318. * (pour info) TAB1.<CHSIGN ;
  10319. *------------------------------------
  10320. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  10321. ISHIFT = VRAI ;
  10322. IRIPPLE = VRAI ;
  10323. FINSI ;
  10324. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  10325. ISHIFT = VRAI ;
  10326. IRIPPLE = FAUX ;
  10327. FINSI ;
  10328. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  10329. ISHIFT = FAUX ;
  10330. IRIPPLE = VRAI ;
  10331. FINSI ;
  10332. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  10333. ISHIFT = FAUX ;
  10334. IRIPPLE = FAUX ;
  10335. FINSI ;
  10336. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  10337. ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
  10338. FINSI ;
  10339. *
  10340. SI (EGA (TYPE CHSIGN) MOT) ;
  10341. * --- Cas ou l'appel vient d'une proc qui n'a pas calcule CHSIGN
  10342. CHSIGN = 1. ;
  10343. FINSI ;
  10344.  
  10345.  
  10346. * ---- Calcul du champ dans le repere global
  10347. BXG BYG BZG FSECU = @CHAMB TAB1 CHP_X CHP_Y CHP_Z ISHIFT IRIPPLE ;
  10348.  
  10349.  
  10350. * ---- Calcul de la norme du champ
  10351.  
  10352. NORM_B = ((BXG*BXG) + (BYG*BYG) + (BZG*BZG))**0.5 ;
  10353.  
  10354.  
  10355. *
  10356. XG_NEW0 = CHP_X + (CHSIGN * BXG * PASB0 / NORM_B) ;
  10357. YG_NEW0 = CHP_Y + (CHSIGN * BYG * PASB0 / NORM_B) ;
  10358. ZG_NEW0 = CHP_Z + (CHSIGN * BZG * PASB0 / NORM_B) ;
  10359.  
  10360. * ---- Coordonnees dans le repere
  10361. * ---- pseudo-toroidal du ripple
  10362. RHOR THER PHIR = @CRGTC CHP_X CHP_Y CHP_Z RR 0. ;
  10363. RHOR_OLD = RHOR ;
  10364. KAUX = (EXP (THER ** 2 * -1. * COEFC))* ((COS (PHIR * NBOB)) * -1. + 1.) * COEFA ;
  10365. I3 = 0 ;
  10366. REPETER BOUCLE3 50 ;
  10367. * I3 =I3 + 1 ; MESS ' I3 =' I3 ;
  10368. RHOR_NEW = RHOR + (KAUX * (EXP(RHOR_OLD * COEFB)));
  10369. SI ((MAXI (ABS((RHOR_NEW - RHOR_OLD)/RHOR_NEW))) &lt;EG EPS0) ;
  10370. QUITTER BOUCLE3 ;
  10371. FINSI ;
  10372. RHOR_OLD = RHOR_NEW ;
  10373. FIN BOUCLE3 ;
  10374.  
  10375. RHOMER = RHOR_NEW ;
  10376.  
  10377. I2 = 0 ;
  10378. REPETER BOUCLE2 2 ;
  10379. I2 =I2 + 1 ;
  10380. * MESS ' I2 =' I2 ;
  10381. * ---- point sur la surface magnetique
  10382. RHORN THERN PHIRN = @CRGTC XG_NEW0 YG_NEW0 ZG_NEW0 RR 0. ;
  10383. DRHOMERN = (EXP (RHOMER*COEFB))*(EXP(THERN**2 *COEFC * -1.)) * COEFA ;
  10384. RHORIP = DRHOMERN * ((COS(PHIRN * NBOB)) - 1.) + RHOMER ;
  10385.  
  10386. XG_NEW1 YG_NEW1 ZG_NEW1 = @CRTGC RHORIP THERN PHIRN RR 0. ;
  10387. *
  10388. * ---- Calcul du champ dans le repere global
  10389. BXG0 BYG0 BZG0 FSECU0 = @CHAMB TAB1 XG_NEW1 YG_NEW1 ZG_NEW1 ISHIFT IRIPPLE ;
  10390.  
  10391. * ---- Moyenne des tangentes
  10392. BXG1 = (BXG + BXG0)/2. ;
  10393. BYG1 = (BYG + BYG0)/2. ;
  10394. BZG1 = (BZG + BZG0)/2. ;
  10395.  
  10396. NORM_B1 = ((BXG1*BXG1) + (BYG1*BYG1) + (BZG1*BZG1))**0.5 ;
  10397.  
  10398. XG_NEW0 = CHP_X + (CHSIGN * BXG1 * PASB0 / NORM_B1) ;
  10399. YG_NEW0 = CHP_Y + (CHSIGN * BYG1 * PASB0 / NORM_B1) ;
  10400. ZG_NEW0 = CHP_Z + (CHSIGN * BZG1 * PASB0 / NORM_B1) ;
  10401.  
  10402. SI (I2 EGA 2);
  10403. XG_NEW = XG_NEW0 ;
  10404. YG_NEW = YG_NEW0 ;
  10405. ZG_NEW = ZG_NEW0 ;
  10406. FINSI ;
  10407.  
  10408. FIN BOUCLE2 ;
  10409.  
  10410. * ---- Calcul des deplacements
  10411.  
  10412. DEPX0 = BXG1 * PASB0 / NORM_B1 ;
  10413. DEPY0 = BYG1 * PASB0 / NORM_B1 ;
  10414. DEPZ0 = BZG1 * PASB0 / NORM_B1 ;
  10415.  
  10416.  
  10417.  
  10418. *MESS '---------------------------------> exiting @DREPROJ';
  10419. FINPROC DEPX0 DEPY0 DEPZ0 ;
  10420. 'DEBPROC' EPSCHL MOD_1*MMODEL SI_13*MCHAM TE0*CHPOINT TE1*CHPOINT TAB1/'TABLE ' ;
  10421. SI (( NON ( EXISTE MAT_1)) ET ( EXISTE TAB1)) ;
  10422. I1 = 0 ;
  10423. REPETER BOMA11 ;
  10424. I1 = I1 + 1 ;
  10425. SI ( EXISTE (TAB1.ZONE_MAT) I1 ) ;
  10426. MO1 = TAB1.MODL_MAT. I1 ;
  10427. TM_1 = ( REDU TE1 TAB1.ZONE_MAT.I1 ) ;
  10428. Y_1 = VARI TM_1 TAB1.TETMAT.MO1.YOUN YOUN ;
  10429. NU_1 = VARI TM_1 TAB1.TETMAT.MO1.NU NU ;
  10430. AL_1 = VARI TM_1 TAB1.TETMAT.MO1.ALPH ALPH ;
  10431. NU_1 = CHANGER CHAM NU_1 MO1 'RIGIDITE' ;
  10432. Y_1 = CHANGER CHAM Y_1 MO1 'RIGIDITE' ;
  10433. AL_1 = CHANGER CHAM AL_1 MO1 'RIGIDITE' ;
  10434. TEX1 = TEXTE 'YOUN Y_1 NU NU_1 ALPH AL_1' ;
  10435. IMOTM1 = DIME (MOTS TAB1.TEXTMECA.I1) ;
  10436. SI ( IMOTM1 EGA 5 ) ;
  10437. TEX1 = TEXTE TEX1 'SIGY YM_1 ' ;
  10438. TITRE 'MAT' I1 ' YIELD MODULUS' ;
  10439. YM_1 = VARI TM_1 TAB1.TETMAT.MO1.SIGY SIGY ;
  10440. YM_1 = CHANGER CHAM YM_1 MO1 'RIGIDITE' ;
  10441. TEX1 = TEXTE TEX1 'H H_1 ' ;
  10442. H_1 = VARI TM_1 TAB1.TETMAT.MO1.H H ;
  10443. H_1 = CHANGER CHAM H_1 MO1 'RIGIDITE' ;
  10444. FINSI ;
  10445. MA1 = MATE MO1 TEX1 ;
  10446. SINON ;
  10447. QUITTER BOMA11 ;
  10448. FINSI ;
  10449. SI ( I1 EGA 1 ) ;
  10450. MOD_1 = MO1 ;
  10451. MAT_1 = MA1 ;
  10452. SINON ;
  10453. MOD_1 = MOD_1 ET MO1 ;
  10454. MAT_1 = MAT_1 ET MA1 ;
  10455. FINSI ;
  10456. FIN BOMA11 ;
  10457. FINSI ;
  10458. TAB1.MATTOT = MAT_1 ;
  10459. SI_11 = THETA MAT_1 ( TE1 - TE0 ) ;
  10460. FO1 = BSIGMA SI_11 ;
  10461. SI_12 = SI_13 + SI_11 ;
  10462. EPS_1 = ELAS MOD_1 SI_12 MAT_1 FINPROC EPS_1 ;**** @EPTH DEBPROC @EPTH CHT1*CHPOINT EV1*EVOLUTION MOD1*MMODEL;
  10463.  
  10464. CHT2 = REDU CHT1 ( EXTR MOD1 'MAIL');
  10465. ALP1 = VARI MOD1 CHT2 EV1;
  10466. ALP2 = CHAN CHPO ALP1 MOD1 ;
  10467. ALP3 = NOMC ALP2 'SCAL' ;
  10468.  
  10469.  
  10470. EPS1 = ALP3 * CHT2;
  10471.  
  10472. EPX1 = NOMC EPS1 'EPXX';
  10473. EPY1 = NOMC EPS1 'EPYY';
  10474. EPZ1 = NOMC EPS1 'EPZZ';
  10475. GAXY1 = NOMC (0. * EPS1) 'GAXY';
  10476. GAXZ1 = NOMC (0. * EPS1) 'GAXZ';
  10477. GAYZ1 = NOMC (0. * EPS1) 'GAYZ';
  10478.  
  10479. EPX2 = CHAN CHAM EPX1 MOD1 'STRESSES';
  10480. EPY2 = CHAN CHAM EPY1 MOD1 'STRESSES';
  10481. EPZ2 = CHAN CHAM EPZ1 MOD1 'STRESSES';
  10482. GAXY2 = CHAN CHAM GAXY1 MOD1 'STRESSES';
  10483. GAXZ2 = CHAN CHAM GAXZ1 MOD1 'STRESSES';
  10484. GAYZ2 = CHAN CHAM GAYZ1 MOD1 'STRESSES';
  10485.  
  10486. EPS_THER = EPX2 ET EPY2 ET EPZ2 ET GAXY2 ET GAXZ2 ET GAYZ2;
  10487.  
  10488.  
  10489. FINPROC EPS_THER ;
  10490.  
  10491.  
  10492. **** @ET
  10493. DEBPROC @ET CH1*CHPOINT CH2*CHPOINT ;
  10494. CHA1 = CHAN 'ATTRIBUT ' CH1 'NATURE' 'DISCRET' ;
  10495. CHA2 = CHAN 'ATTRIBUT ' CH2 'NATURE' 'DISCRET' ;
  10496. CHR = CHA1 ET CHA2;
  10497. FINPROC CHR ;
  10498. **** @EVMAA
  10499. DEBPROC @EVMAA NOMM*MOT TIN1*FLOTTANT ;
  10500.  
  10501. EVE2 = @EVMAT NOMM 'ALPHA' ;
  10502. LLTE1 = EXTR EVE2 'ABSC' ;
  10503. KK1 = MINI ( ABS ( LLTE1 - (PROG (DIME LLTE1) * TIN1)));
  10504.  
  10505. SI (KK1 EGA 0. 1. ) ;
  10506. LLTE1 = LLTE1 + (PROG (DIME LLTE1) * 10.) ;
  10507. PP1 = @IPOE LLTE1 EVE2 FIXE ;
  10508. EVE2 = EVOL MANU 'TEMPERATURE' LLTE1 'ALPH' PP1 ;
  10509. FINSI ;
  10510.  
  10511. EVOC700 = EVOL MANU 'TEMPERATURE' LLTE1 'ALPH' ( PROG (DIME LLTE1) * (TIN1 - 20.)) ;
  10512.  
  10513. EVOCT1 = EVOL MANU 'TEMPERATURE' LLTE1 'ALPH' (LLTE1 - (PROG (DIME LLTE1) * 20.)) ;
  10514.  
  10515. EVOCTY1 = EVOL MANU 'TEMPERATURE' LLTE1 'ALPH' (PROG (DIME LLTE1) * ((TIN1 - 20.) * (EVMAT NOMM 'ALPHA' TIN1)));
  10516.  
  10517. BETA1 = ((EVOCTY1 - (EVE2 * EVOCT1))/(EVOC700 - EVOCT1)) ;
  10518.  
  10519. FINPROC BETA1 ;
  10520. **** @EVMAT
  10521. 'DEBPROC' @EVMAT MOT1*'MOT ' MOT2*'MOT ' VAL1/FLOTTANT CHP1/CHPOINT TABTT/TABLE ;
  10522. *23456789012345678901234567890123456789012345678901234567890123456789012
  10523. * 1 2 3 4 5 6 7
  10524. * version créee 19.12.96 par R. Mitteau pour fonctionner avec PASAPAS
  10525. *modification des noms de composantes :
  10526. * 'TEMPERATURE' -> 'T'
  10527. * 'CONDUCTIVITE' -> 'K'
  10528. * 'CAPACITE' -> 'CapaVolu'
  10529.  
  10530. SI ( EXISTE TABTT) ;
  10531. TABT = TABLE TABTT ;
  10532. SINON ;
  10533. TABT = TABLE ;
  10534. FINSI ;
  10535. TT1 = TABLE ;
  10536. REPETER BLOC1 1 ;
  10537.  
  10538. SI ( EGA MOT1 'DUNLOP' ) ;
  10539. * donnees bonnal 19 avril 93
  10540. TT1.'DUNLOP' = TABLE ;
  10541. 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.) ;
  10542. *TITRE ' DUNLOP SPECIF HEAT' ;
  10543. 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.) ;
  10544.  
  10545. *TITRE ' DUNLOP DENSITY' ;
  10546. 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. );
  10547.  
  10548. EVRHOC = (TT1.'DUNLOP' . 'RHO') * ( TT1.'DUNLOP' . 'C') ;
  10549. TT1.'DUNLOP' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10550. QUITTER BLOC1 ;
  10551. FINSI ;
  10552. ***********************************************************************
  10553. * N11 redensifie direction P
  10554. * materiau rentre par Raphael Mitteau le 6 juin 1996
  10555. * Source SEP lineaire entre 20 et 1000 C
  10556. SI ( EGA MOT1 'N11P_DENSE1' ) ;
  10557. *
  10558. * --- definition de la table
  10559. *
  10560. TT1.'N11P_DENSE1' = TABLE ;
  10561. *
  10562. * --- definition de la conductivite thermique
  10563. *
  10564. TT1.'N11P_DENSE1' . 'K' = EVOL MANU 'T' (PROG -200. 20. 1000. ) 'K' (PROG 250. 250. 100.) ;
  10565. *
  10566. * --- tout est defini, on quitte les bloc de definition des materiaux
  10567. *
  10568. QUITTER BLOC1 ;
  10569. FINSI ;
  10570. * N11 redensifie direction P
  10571. * materiau rentre par Raphael Mitteau le 6 juin 1996
  10572. * Source SEP a 20 et 1000 C copie variation N11
  10573. SI ( EGA MOT1 'N11P_DENSE2' ) ;
  10574. *
  10575. * --- definition de la table
  10576. *
  10577. TT1.'N11P_DENSE2' = TABLE ;
  10578. *
  10579. * --- definition de la conductivite thermique
  10580. *
  10581. 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.));
  10582. *
  10583. * --- tout est defini, on quitte les bloc de definition des materiaux
  10584. *
  10585. QUITTER BLOC1 ;
  10586. FINSI ;
  10587. ***********************************************************************
  10588. * Dunlop concept 1 conductivite dana la direction X mesure par CEA
  10589. * materiau rentre par Raphael Mitteau le 5 juin 1996
  10590. * source CEA/DRN/DMT 95-495 rapport de J.P. Bonal
  10591. SI ( EGA MOT1 'DUN_C1_BONAL_X' ) ;
  10592. *
  10593. * --- definition de la table
  10594. *
  10595. TT1.'DUN_C1_BONAL_X' = TABLE ;
  10596. *
  10597. * --- definition de la conductivite thermique
  10598. *
  10599. 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 ) ;
  10600. *
  10601. * --- tout est defini, on quitte les bloc de definition des materiaux
  10602. *
  10603. QUITTER BLOC1 ;
  10604. FINSI ;
  10605. ***********************************************************************
  10606. * Dunlop concept 1 conductivite dana la direction X mesure par CEA
  10607. * materiau rentre par Raphael Mitteau le 5 juin 1996
  10608. * source CEA/DRN/DMT 95-495 rapport de J.P. Bonal
  10609. SI ( EGA MOT1 'DUN_C1_BONAL_Y' ) ;
  10610. *
  10611. * --- definition de la table
  10612. *
  10613. TT1.'DUN_C1_BONAL_Y' = TABLE ;
  10614. *
  10615. * --- definition de la conductivite thermique
  10616. *
  10617. 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 ) ;
  10618. *
  10619. * --- tout est defini, on quitte les bloc de definition des materiaux
  10620. *
  10621. QUITTER BLOC1 ;
  10622. FINSI ;
  10623. ***********************************************************************
  10624. * Sepcarb NB31 Version C conductivite dana la direction X
  10625. * materiau rentre par Raphael Mitteau le 5 juin 1996
  10626. * source SEP
  10627. SI ( EGA MOT1 'NB31CX' ) ;
  10628. *
  10629. * --- definition de la table
  10630. *
  10631. TT1.'NB31CX' = TABLE ;
  10632. *
  10633. * --- definition de la conductivite thermique
  10634. *
  10635. * --- approximation lineaire
  10636. TT1.'NB31CX' . 'K' = EVOL MANU 'T' (PROG -200. 20. 800. 1000. 2000.) 'K' (PROG 323. 323. 154. 145. 145. ) ;
  10637.  
  10638. * --- variation copiee sur celle du N11
  10639. 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.));
  10640. *
  10641. * --- tout est defini, on quitte les bloc de definition des materiaux
  10642. *
  10643. QUITTER BLOC1 ;
  10644. FINSI ;
  10645. ***********************************************************************
  10646. * Sepcarb NB31 Version C conductivite dans la direction Y
  10647. * materiau rentre par Raphael Mitteau le 5 juin 1996
  10648. * source SEP
  10649. SI ( EGA MOT1 'NB31CY' ) ;
  10650. *
  10651. * --- definition de la table
  10652. *
  10653. TT1.'NB31CY' = TABLE ;
  10654. *
  10655. * --- definition de la conductivite thermique
  10656. *
  10657.  
  10658. * --- approximation lineaire
  10659.  
  10660. TT1.'NB31CY' . 'K' = EVOL MANU 'T' (PROG -200. 20. 800. 1000. 2000.) 'K'(PROG 117. 117. 58. 56. 56. ) ;
  10661.  
  10662. * --- variation copiee sur celle du N11
  10663.  
  10664. 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.));
  10665. *
  10666. * --- tout est defini, on quitte les bloc de definition des materiaux
  10667. *
  10668. QUITTER BLOC1 ;
  10669. FINSI ;
  10670. ***********************************************************************
  10671. * Sepcarb NB31 Version C conductivite dans la direction Z
  10672. * materiau rentre par Raphael Mitteau le 5 juin 1996
  10673. * source SEP
  10674. SI ( EGA MOT1 'NB31CZ' ) ;
  10675. *
  10676. * --- definition de la table
  10677. *
  10678. TT1.'NB31CZ' = TABLE ;
  10679. *
  10680. * --- definition de la conductivite thermique
  10681. *
  10682. TT1.'NB31CZ' . 'K' = EVOL MANU 'T' (PROG -200. 20. 800. 1000. 2000.) 'K'(PROG 115. 115. 55. 52. 52. ) ;
  10683. *
  10684. * --- tout est defini, on quitte les bloc de definition des materiaux
  10685. *
  10686. QUITTER BLOC1 ;
  10687. FINSI ;
  10688.  
  10689. ***********************************************************************
  10690. * Sepcarb NS31 Version C conductivite dans la direction X
  10691. * materiau rentre par Raphael Mitteau le 10 septembre 1996
  10692. * source SEP
  10693. SI ( EGA MOT1 'NS31CX' ) ;
  10694. *
  10695. * --- definition de la table
  10696. *
  10697. TT1.'NS31CX' = TABLE ;
  10698. *
  10699. * --- definition de la conductivite thermique
  10700. *
  10701. * --- approximation lineaire
  10702. TT1.'NS31CX' . 'K' = EVOL MANU 'T' (PROG -200. 20. 800. 1000. 2000.) 'K' (PROG 304. 304. 149. 141. 141. ) ;
  10703.  
  10704. * --- variation copiee sur celle du N11
  10705. 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.));
  10706. *
  10707. * --- tout est defini, on quitte les bloc de definition des materiaux
  10708. *
  10709. QUITTER BLOC1 ;
  10710. FINSI ;
  10711. ***********************************************************************
  10712. * Sepcarb NS31 Version C conductivite dans la direction Y
  10713. * materiau rentre par Raphael Mitteau le 10 septembre 1996
  10714. * source SEP
  10715. SI ( EGA MOT1 'NS31CY' ) ;
  10716. *
  10717. * --- definition de la table
  10718. *
  10719. TT1.'NS31CY' = TABLE ;
  10720. *
  10721. * --- definition de la conductivite thermique
  10722. *
  10723.  
  10724. * --- approximation lineaire
  10725.  
  10726. TT1.'NS31CY' . 'K' = EVOL MANU 'T' (PROG -200. 20. 800. 1000. 2000.) 'K'(PROG 100. 100. 55. 54. 54. ) ;
  10727.  
  10728. * --- variation copiee sur celle du N11
  10729.  
  10730. 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.));
  10731. *
  10732. * --- tout est defini, on quitte les bloc de definition des materiaux
  10733. *
  10734. QUITTER BLOC1 ;
  10735. FINSI ;
  10736. ***********************************************************************
  10737. * Sepcarb NB31 Version C conductivite dans la direction Z
  10738. * materiau rentre par Raphael Mitteau le 10 septembre 1996
  10739. * source SEP
  10740. SI ( EGA MOT1 'NS31CZ' ) ;
  10741. *
  10742. * --- definition de la table
  10743. *
  10744. TT1.'NS31CZ' = TABLE ;
  10745. *
  10746. * --- definition de la conductivite thermique
  10747. *
  10748. TT1.'NS31CZ' . 'K' = EVOL MANU 'T' (PROG -200. 20. 800. 1000. 2000.) 'K'(PROG 91. 91. 48. 43. 43. ) ;
  10749. *
  10750. * --- variation copiee sur celle du N11
  10751. *
  10752.  
  10753. 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.));
  10754. *
  10755. * --- tout est defini, on quitte les bloc de definition des materiaux
  10756. *
  10757. QUITTER BLOC1 ;
  10758. FINSI ;
  10759.  
  10760. ***********************************************************************
  10761. * stands for DUNLOP CONCEPT 1
  10762. * valeurs rentrees le 04 mai 95 par J.F. Salavy
  10763.  
  10764. * source : DUNLOP LIMITED AVIATION DIVISION (net supply contract
  10765. * no 92-825A) envoyees par Ivi Smid le 29/03/95
  10766. * donnees entre 25 et 1200 C
  10767. * Pour cond_Z, les valeurs sont celles de la courbe et non du tableau
  10768.  
  10769. SI ( EGA MOT1 'DUN_CONCEPT1_X' ) ;
  10770.  
  10771. TT1.'DUN_CONCEPT1_X' = TABLE ;
  10772.  
  10773. 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. ) ;
  10774.  
  10775. 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. ) ;
  10776.  
  10777. 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. );
  10778.  
  10779. EVRHOC = ( TT1.'DUN_CONCEPT1_X' . 'RHO') * ( TT1.'DUN_CONCEPT1_X' . 'C');
  10780.  
  10781. TT1.'DUN_CONCEPT1_X' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10782.  
  10783. QUITTER BLOC1 ;
  10784. FINSI ;
  10785.  
  10786. SI ( EGA MOT1 'DUN_CONCEPT1_Y' ) ;
  10787.  
  10788. TT1.'DUN_CONCEPT1_Y' = TABLE ;
  10789.  
  10790. 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. ) ;
  10791.  
  10792. 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. );
  10793.  
  10794. 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. );
  10795.  
  10796. EVRHOC = ( TT1.'DUN_CONCEPT1_Y' . 'RHO') * ( TT1.'DUN_CONCEPT1_Y' . 'C');
  10797.  
  10798. TT1.'DUN_CONCEPT1_Y' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10799.  
  10800. QUITTER BLOC1 ;
  10801. FINSI ;
  10802.  
  10803. SI ( EGA MOT1 'DUN_CONCEPT1_Z' ) ;
  10804.  
  10805. TT1.'DUN_CONCEPT1_Z' = TABLE ;
  10806.  
  10807. 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. ) ;
  10808.  
  10809. 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. );
  10810.  
  10811. 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. );
  10812.  
  10813. EVRHOC = ( TT1.'DUN_CONCEPT1_Z' . 'RHO') * ( TT1.'DUN_CONCEPT1_Z' . 'C');
  10814.  
  10815. TT1.'DUN_CONCEPT1_Z' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10816.  
  10817. QUITTER BLOC1 ;
  10818. FINSI ;
  10819. **********************************************************************
  10820.  
  10821. LL1 = (( EGA MOT1 'DUNX' ) OU ( EGA MOT1 'I1DUNX' ) OU ( EGA MOT1 'DUNY' ) OU ( EGA MOT1 'I1DUNY' ));
  10822. SI LL1 ;
  10823. * Valeurs fournies par Deschamps le 12/02/93 a 20. et 1000. degres C
  10824. TT1.'DUNX' = TABLE ;
  10825. *
  10826. 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.) ;
  10827. *
  10828.  
  10829. TT1.'DUNY' = TABLE ;
  10830. *
  10831. 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.) ;
  10832. *
  10833. *
  10834. * Valeurs fournies par Deschamps le 12/02/93 a 20. et 1000. degres C
  10835. TT1.'I1DUNX' = TABLE ;
  10836. *
  10837.  
  10838. 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 ;
  10839. 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) ;
  10840. *
  10841. TT1.'I1DUNY' = TABLE ;
  10842. *
  10843. 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 ;
  10844. 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) ;
  10845. *
  10846. *
  10847. QUITTER BLOC1 ;
  10848. FINSI ;
  10849.  
  10850. ****************************************************************&*****
  10851. SI ( EGA MOT1 'N112X' ) ;
  10852. * Valeurs fournies par Deschamps le 12/02/93 a 20. et 1000. degres C
  10853. TT1.'N112X' = TABLE ;
  10854. *
  10855. 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.) ;
  10856. *
  10857. 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 );
  10858. QUITTER BLOC1 ;
  10859. FINSI ;
  10860. ***********************************************************************
  10861. SI ( EGA MOT1 'N112Y' ) ;
  10862. TT1.'N112Y' = TABLE ;
  10863. *
  10864. 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.) ;
  10865. *
  10866. 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 );
  10867. *
  10868. QUITTER BLOC1 ;
  10869. FINSI ;
  10870. SI ( EGA MOT1 'N112Z' ) ;
  10871. TT1.'N112Z' = TABLE ;
  10872. *
  10873. 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.) ;
  10874. *
  10875. 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 );
  10876. QUITTER BLOC1 ;
  10877. FINSI ;
  10878. ***********************************************************************
  10879. SI ( EGA MOT1 'N112P' ) ;
  10880. * donnees bonnal 19 avril 93
  10881. TT1.'N112P' = TABLE ;
  10882. 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.) ;
  10883. *TITRE ' N112P SPECIF HEAT' ;
  10884. 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.) ;
  10885.  
  10886. *TITRE ' N112P DENSITY' ;
  10887. 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. );
  10888.  
  10889. EVRHOC = (TT1.'N112P' . 'RHO') * ( TT1.'N112P' . 'C') ;
  10890. TT1.'N112P' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10891. QUITTER BLOC1 ;
  10892. FINSI ;
  10893. ***********************************************************************
  10894. SI ( EGA MOT1 'N112H' ) ;
  10895.  
  10896. TT1.'N112H' = TABLE ;
  10897. *
  10898. * TITRE ' N112 H CONDUCTIVITY' ;
  10899. 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.) ;
  10900. QUITTER BLOC1 ;
  10901. FINSI ;
  10902. ***********************************************************************
  10903. SI ( EGA MOT1 'N112' ) ;
  10904. TT1.'N112' = TABLE ;
  10905. *
  10906. 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.) ;
  10907.  
  10908. *TITRE ' N112 SPECIF HEAT' ;
  10909. 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.) ;
  10910.  
  10911. *TITRE ' N112 DENSITY' ;
  10912. 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.);
  10913.  
  10914. EVRHOC = (TT1.'N112' . 'RHO') * ( TT1.'N112' . 'C') ;
  10915. TT1.'N112' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10916. * valeurs donnee par Deschamps 28 le 16.02.93
  10917. 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);
  10918. *
  10919. QUITTER BLOC1 ;
  10920. FINSI ;
  10921. ***********************************************************************
  10922. SI ( EGA MOT1 'N11' ) ;
  10923. TT1.'N11' = TABLE ;
  10924. *
  10925. *js 190296 TT1.'N11' . 'K' = EVOL MANU
  10926. *js 190296 'T' (PROG -500. 23. 350. 500. 1000. 1500. 2000. 4.5E3)
  10927. *js 190296 'K'(PROG 210. 210. 123. 105. 76. 62. 52. 52.) ;
  10928. 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.) );
  10929.  
  10930. *TITRE ' N11 SPECIF HEAT' ;
  10931. 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.) ;
  10932.  
  10933. *TITRE ' N11 DENSITY' ;
  10934. 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.);
  10935.  
  10936. EVRHOC = (TT1.'N11' . 'RHO') * ( TT1.'N11' . 'C') ;
  10937. TT1.'N11' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10938.  
  10939. * valeurs donnee par Deschamps 28 le 16.02.93
  10940. 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);
  10941. *
  10942. QUITTER BLOC1 ;
  10943. FINSI ;
  10944.  
  10945. ***************************************************************************
  10946. SI ( EGA MOT1 'N11_PPI' ) ;
  10947. TT1.'N11_PPI' = TABLE ;
  10948.  
  10949. * ....Lipa...actualise les valeurs le 28.3.95..suivant mesures PPI.
  10950.  
  10951. 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.) ;
  10952.  
  10953. *TITRE ' N11_PPI SPECIF HEAT' ;
  10954. 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.) ;
  10955.  
  10956. *TITRE ' N11_PPI DENSITY' ;
  10957. 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.);
  10958.  
  10959. EVRHOC = (TT1.'N11_PPI' . 'RHO') * ( TT1.'N11_PPI' . 'C') ;
  10960. TT1.'N11_PPI' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10961. * valeurs donnee par Deschamps 28 le 16.02.93
  10962.  
  10963. 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);
  10964.  
  10965. 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 );
  10966.  
  10967. 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 );
  10968. *
  10969. QUITTER BLOC1 ;
  10970. FINSI ;
  10971. ***********************************************************************
  10972. SI ( EGA MOT1 'I1N112P' ) ;
  10973. * creation de ce materiau par J. SCHLOS le 22/09/94
  10974. * valeurs dans le plan, moyenne des directions x et y
  10975. * N112 // irradie at 640 deg C / 1.25 dpa.g
  10976. TT1.'I1N112P' = TABLE ;
  10977. *
  10978. 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) );
  10979. * Source :Bonnal telecopie a Deschamps le 21 09 94
  10980. * extrapole au dessus de 600.
  10981.  
  10982. *TITRE ' I1N112P SPECIF HEAT' ;
  10983. 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 ) );
  10984.  
  10985.  
  10986. *TITRE ' I1N112P DENSITY' ;
  10987. 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.);
  10988. EVRHOC = (TT1.'I1N112P' . 'RHO') * ( TT1.'I1N112P' . 'C') ;
  10989. TT1.'I1N112P' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  10990. QUITTER BLOC1 ;
  10991. FINSI ;
  10992. **************************************************************************************
  10993. SI ( EGA MOT1 'N11P' ) ;
  10994. * creation de ce materiau par R. MITTEAU le 20/01/94
  10995. * valeurs dans le plan, moyenne des directions x et y
  10996. * MODIF Fred.ESC. le 28/10/95 *****
  10997. * But de la manoeuvre :ameliorer la conductivite a haute temperature
  10998. * MODIF 1 : otpimisation au dela de 800 degC
  10999.  
  11000. TT1.'N11P' = TABLE ;
  11001. 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.) );
  11002.  
  11003. *ESC 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 74.5 41.
  11004. *ESC 41. 41. 41.) * ( 240./247.) );
  11005.  
  11006. * MODIF 2 : MODIF 1 * ( 240./247.)
  11007. * 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 94.36 77.36
  11008. * 67.19 60.23 45.23) * ( 240./247.) );
  11009. * MODIF 3 : MODIF 2 * ( 1.05 )
  11010. * 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 99.08 81.23
  11011. * 70.54 63.25 47.5) * ( 240./247.) );
  11012. * MODIF 4 : ORIGINAL * ( 1.1 )
  11013. *153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 74.5 41.
  11014. * 41. 41. 41.) * ( 240./247.*1.1) );
  11015. * FIN MODIF Fred. ESC le 28/10/95 *****
  11016. * Source : Valeur a 25 C donnee par Chappuis selon mesures SEP
  11017. * (registre de controle individuel)2129043
  11018. * extrapolees pour les temperatures superieures selon valeurs
  11019. * du rapport DMT/93-265, J.P. BONAL, Elements pour la constitution
  11020. * d'une base de donnee sur les composites carbone-carboneA05 A035
  11021. * N11 N112 envisages pour la fusion thermonucleaire
  11022. * Aout 1993, extrapollee exponentiellement au dela de 800 C
  11023.  
  11024. *TITRE ' N11P SPECIF HEAT' ;
  11025. 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 ) ;
  11026. * source: rapport DMT/93-265, J.P. BONAL, Elements pour la constitution
  11027. * d'une base de donnee sur les composites carbone-carboneA05 A035
  11028. * N11 N112 envisages pour la fusion thermonucleaire
  11029. * Aout 1993, extrapollee exponentiellement au dela de 800 C
  11030.  
  11031. *TITRE ' N11P DENSITY' ;
  11032. 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.);
  11033.  
  11034. EVRHOC = (TT1.'N11P' . 'RHO') * ( TT1.'N11P' . 'C') ;
  11035. TT1.'N11P' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11036.  
  11037. 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 ));
  11038. * Source : Valeur a 20 C donnee par Chappuis selon mesures SEP
  11039. * extrapolees pour les temperatures superieures selon lois precedentes
  11040.  
  11041. 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));
  11042. * Source : Valeur a 20 C donnee par Chappuis selon mesures SEP
  11043. * extrapolees pour les temperatures superieures selon lois precedentes
  11044. *
  11045. 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 );
  11046. * Pris egal a celui de A05 par defaut d'autre valeur
  11047. QUITTER BLOC1 ;
  11048. FINSI ;
  11049. ***********************************************************************
  11050. SI ( EGA MOT1 'N11H' ) ;
  11051. * creation de ce materiau par R. MITTEAU le 20/01/94
  11052.  
  11053. TT1.'N11H' = TABLE ;
  11054. *
  11055. 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));
  11056. * Source : Valeur a 25 C donnee par Chappuis selon mesures SEP
  11057. * (registre de controle individuel) 2129043
  11058. * extrapolees pour les temperatures superieures selon valeurs
  11059. * du rapport DMT/93-265, J.P. BONAL, Elements pour la constitution
  11060. * d'une base de donnee sur les composites carbone-carbone A05 A035
  11061. * N11 N112 envisages pour la fusion thermonucleaire
  11062. * Aout 1993, extrapollee exponentiellement au dela de 800 C
  11063.  
  11064. *TITRE ' N11H SPECIF HEAT' ;
  11065. 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 ) ;
  11066. * source rapport DMT/93-265, J.P. BONAL, Elements pour la constitution
  11067. * d'une base de donnee sur les composites carbone-carbone A05 A035
  11068. * N11 N112 envisages pour la fusion thermonucleaire
  11069. * Aout 1993, extrapollee y=a*(x**b) au dela de 800 C
  11070.  
  11071. *TITRE ' N11H DENSITY' ;
  11072. 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.);
  11073.  
  11074. EVRHOC = (TT1.'N11H' . 'RHO') * ( TT1.'N11H' . 'C') ;
  11075. TT1.'N11H' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11076.  
  11077. 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));
  11078. * Source : Valeur a 25 C donnee par Chappuis selon mesures SEP
  11079. * (registre de controle individuel)2129043
  11080. * extrapolee en T suivant loi ?
  11081.  
  11082. 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);
  11083. * source : valeurs donnees par Deschamps le 16.02.93
  11084.  
  11085.  
  11086. 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 );
  11087. * Pris egal a celui de A05 par defaut d'autre valeur
  11088. QUITTER BLOC1 ;
  11089. FINSI ;
  11090. ***********************************************************************
  11091. SI ( EGA MOT1 '5890PT' ) ;
  11092. TT1.'5890PT' = TABLE ;
  11093. *
  11094. *TITRE ' 5890PT CONDUCTIVITY' ;
  11095. 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);
  11096.  
  11097. TT1.'5890PT' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 9.5E3) 'RHO'(PROG 1820. 1820. 1820. 1820. 1820. 1820. 1820. );
  11098.  
  11099. TT1.'5890PT' . 'C' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 9.5E3) 'C'(PROG 880. 880. 1520. 1940. 2110. 2280. 2280.);
  11100.  
  11101. EVRHOC = (TT1.'5890PT' . 'RHO') * ( TT1.'5890PT' . 'C');
  11102.  
  11103. TT1.'5890PT' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11104. *
  11105. * caracteristiques mecaniques ajoutees par R. MITTEAU le 30 mars 1994
  11106.  
  11107. 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);
  11108. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11109. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11110.  
  11111. 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);
  11112. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11113. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11114.  
  11115. 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 );
  11116. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11117. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11118. QUITTER BLOC1 ;
  11119. FINSI ;
  11120. *********************************************************************
  11121. SI ( EGA MOT1 'PYRO_GP' ) ;
  11122. TT1.'PYRO_GP' = TABLE ;
  11123. *
  11124. *TITRE ' PYRO_GP CONDUCTIVITY' ;
  11125. 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. );
  11126.  
  11127. 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. );
  11128.  
  11129. 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.);
  11130.  
  11131. EVRHOC = (TT1.'PYRO_GP' . 'RHO') * ( TT1.'PYRO_GP' . 'C');
  11132.  
  11133. TT1.'PYRO_GP' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11134. QUITTER BLOC1 ;
  11135. FINSI ;
  11136. **********************************************************************
  11137. SI ( EGA MOT1 'PYRO_GH' ) ;
  11138. *
  11139. TT1.'PYRO_GH' = TABLE ;
  11140. *
  11141. *TITRE ' PYRO_GH CONDUCTIVITY' ;
  11142. 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. );
  11143.  
  11144. 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. );
  11145.  
  11146. 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.);
  11147.  
  11148. EVRHOC = (TT1.'PYRO_GP' . 'RHO') * ( TT1.'PYRO_GP' . 'C');
  11149.  
  11150. TT1.'PYRO_GH' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11151. *
  11152. QUITTER BLOC1 ;
  11153. FINSI ;
  11154. **********************************************************************
  11155. SI ( EGA MOT1 'TOYOTANSO' ) ;
  11156. TT1.'TOYOTANSO' = TABLE ;
  11157. *
  11158. LR1 = PROG 0. 20. 25. 50. 100. 150. 200. 250. 300. 350. 400. 450. 500. 550. 600. 650. 700. 750. 800. 4500. ;
  11159. 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 ;
  11160. *TITRE ' TOYOTANSO CONDUCTIVITY' ;
  11161. TT1.'TOYOTANSO' . 'K' = EVOL MANU 'T' LR1 'K' LR2 ;
  11162.  
  11163. LD = PROG 1838 1838 1838 1837 1836 1835 1833 1832 1831 1829 1828 1827 1825 1824 1823 1821 1820 1819 1817 1817 ;
  11164. TT1.'TOYOTANSO' . 'RHO' = EVOL MANU 'T' LR1 'RHO' LD ;
  11165.  
  11166. 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 ;
  11167. TT1.'TOYOTANSO' . 'C' = EVOL MANU 'T' LR1 'C'LR4;
  11168.  
  11169. EVRHOC = (TT1.'TOYOTANSO' . 'RHO') * ( TT1.'TOYOTANSO' . 'C');
  11170.  
  11171. TT1.'TOYOTANSO' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11172. QUITTER BLOC1 ;
  11173. FINSI ;
  11174. **********************************************************************
  11175. SI ( EGA MOT1 'A05P' ) ;
  11176.  
  11177. TT1.'A05P' = TABLE ;
  11178.  
  11179. * 31/7/92 diminution de la conduc A05
  11180.  
  11181. *TITRE ' A05 // CONDUCTIVITY' ;
  11182. 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.) ;
  11183.  
  11184. *
  11185. TT1.'A05P' . 'C' = EVOL MANU 'T' (PROG -5000. 20. 500. 1000. 2000. 9.5E3) 'C' ( PROG 880. 880. 1500. 1900. 2070. 2070.);
  11186.  
  11187. TT1.'A05P' . 'RHO' = EVOL MANU 'T' (PROG -5000. 20. 500. 1000. 2000. 9.5E3) 'RHO' (PROG 1770. 1770. 1770. 1770. 1770. 1770.);
  11188.  
  11189. EVRHOC = (TT1.'A05P' . 'RHO') * ( TT1.'A05P' . 'C');
  11190.  
  11191. TT1.'A05P' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11192.  
  11193. 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);
  11194.  
  11195. 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 );
  11196.  
  11197. 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 );
  11198. QUITTER BLOC1 ;
  11199. FINSI ;
  11200. **********************************************************************
  11201. SI ( EGA MOT1 'A05H' ) ;
  11202. TT1.'A05H' = TABLE ;
  11203. *
  11204. *TITRE ' A05 H CONDUCTIVITY' ;
  11205. 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.) ;
  11206.  
  11207. * alpha pris egal a 6 * alpha de A05P le 3 decembre 1993
  11208. * R.MITTEAU - J. SCHLOSSER
  11209. 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 );
  11210.  
  11211. * toutes evolutions suivantes de A05 H prises egales a celle
  11212. * de A05P le 3 decembre 1993 R.MITTEAU - J. SCHLOSSER
  11213. TT1.'A05H' . 'C' = EVOL MANU 'T' (PROG -5000. 20. 500. 1000. 2000. 9.5E3) 'C' ( PROG 880. 880. 1500. 1900. 2070. 2070.);
  11214.  
  11215. TT1.'A05H' . 'RHO' = EVOL MANU 'T' (PROG -5000. 20. 500. 1000. 2000. 9.5E3) 'RHO' (PROG 1770. 1770. 1770. 1770. 1770. 1770.);
  11216.  
  11217. EVRHOC = (TT1.'A05H' . 'RHO') * ( TT1.'A05H' . 'C');
  11218.  
  11219. TT1.'A05H' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11220.  
  11221.  
  11222. 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);
  11223.  
  11224. 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 );
  11225. QUITTER BLOC1 ;
  11226. FINSI ;
  11227. ********************************************************************************
  11228. SI ( EGA MOT1 'A05ORT3D' ) ;
  11229. * ce materiau est de l A05 orthotrope en 3 dimensions
  11230. * plans conducteurs dans la direction 2 - 3
  11231. * mis a jour le 22/12/93 par R. MITTEAU
  11232.  
  11233. TT1.'A05ORT3D' = TABLE ;
  11234.  
  11235. *------------------------ Donnees thermiques
  11236.  
  11237. 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.) ;
  11238. * ref : inconnue
  11239.  
  11240.  
  11241. 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.) ;
  11242. * ref Le Carbone Lorraine
  11243.  
  11244. 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.) ;
  11245. * reference Le Carbone Lorraine
  11246.  
  11247.  
  11248. TT1.'A05ORT3D' . 'C' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 2000. 4.5E3) 'C' ( PROG 880. 880. 1500. 1900. 2070. 2070.);
  11249. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11250.  
  11251.  
  11252. TT1.'A05ORT3D' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 2000. 4.5E3) 'RHO' (PROG 1770. 1770. 1770. 1770. 1770. 1770.);
  11253. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11254.  
  11255. EVRHOC = (TT1.'A05ORT3D' . 'RHO') * ( TT1.'A05ORT3D' . 'C');
  11256.  
  11257. TT1.'A05ORT3D' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11258.  
  11259. *------------------------ Donnees mecaniques
  11260.  
  11261. 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);
  11262. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11263.  
  11264. 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) ;
  11265. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11266.  
  11267. 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);
  11268. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11269.  
  11270. 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 );
  11271. * ref : Le Carbone Lorraine, generalise pour toutes les T et directions
  11272.  
  11273. 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 );
  11274. * ref : Le Carbone Lorraine, generalise pour toutes les T et directions
  11275.  
  11276. 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 );
  11277. * ref : Le Carbone Lorraine, generalise pour toutes les T et directions
  11278.  
  11279.  
  11280. 1PLUS = EVOL MANU 'T' (PROG 0. 20. 300. 500. 700. 900. 4000.) 'NU' (PROG 1. 1. 1. 1. 1. 1. 1.);
  11281.  
  11282. TT1.'A05ORT3D' . 'G12' = TT1.'A05ORT3D' . 'YG3' /(2* (1PLUS + TT1.'A05ORT3D' . 'NU12' ));
  11283. * ref : formule G = E / (2 * (1 + nu)), a verifier en orthotrope
  11284.  
  11285. TT1.'A05ORT3D' . 'G23' = TT1.'A05ORT3D' . 'YG1' /(2* (1PLUS + TT1.'A05ORT3D' . 'NU23' ));
  11286. * ref : formule G = E / (2 * (1 + nu)), a verifier en orthotrope
  11287.  
  11288.  
  11289. TT1.'A05ORT3D' . 'G13' = TT1.'A05ORT3D' . 'YG2' /(2* (1PLUS + TT1.'A05ORT3D' . 'NU13' ));
  11290. * ref : formule G = E / (2 * (1 + nu)), a verifier en orthotrope
  11291.  
  11292.  
  11293. * TT1.'A05ORT3D' . 'G12' = EVOL MANU
  11294. *'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 )
  11295. * 'COULOMB' (1.6*(PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9));
  11296. * TT1.'A05ORT3D' . 'G23' = EVOL MANU
  11297. *'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 )
  11298. * 'COULOMB' (1.7*(PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9));
  11299. * TT1.'A05ORT3D' . 'G13' = EVOL MANU
  11300. *'T' (PROG 0. 20. 500. 1000. 2000. 4.5E3 )
  11301. * 'COULOMB' (1.8*(PROG 20.E9 20.E9 22.E9 24.E9 26.E9 26.E9));
  11302.  
  11303. 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 ) ;
  11304. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11305. * interpole a partir des valeurs a 20 C et 2000 C
  11306.  
  11307. 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 );
  11308. * interpole a partir des valeurs a 20 C et 2000 C
  11309. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11310.  
  11311. 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 );
  11312. * ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
  11313. * interpole a partir des valeurs a 20 C et 2000 C
  11314.  
  11315. QUITTER BLOC1 ;
  11316. FINSI ;
  11317. **********************************************************************
  11318.  
  11319. SI ( EGA MOT1 'A05ORT2D' ) ;
  11320. * ce materiau est de l A05 orthotrope en 2 dimensions
  11321. * plans conducteurs dans la direction
  11322. TT1.'A05ORT2D' = TABLE ;
  11323.  
  11324. *------------------------ Donnees thermiques
  11325.  
  11326. 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.) ;
  11327.  
  11328.  
  11329. TT1.'A05ORT2D' . 'C' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 2000. 4.5E3) 'C' ( PROG 880. 880. 1500. 1900. 2070. 2070.);
  11330.  
  11331. TT1.'A05ORT2D' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 500. 1000. 2000. 4.5E3) 'RHO' (PROG 1770. 1770. 1770. 1770. 1770. 1770.);
  11332.  
  11333. EVRHOC = (TT1.'A05ORT2D' . 'RHO') * ( TT1.'A05ORT2D' . 'C');
  11334.  
  11335. TT1.'A05ORT2D' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11336.  
  11337. *------------------------ Donnees mecaniques
  11338. * le 6/12/93, tout est bidon et ne sert qu a verifier
  11339. * que l orthotropie passe
  11340.  
  11341. 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);
  11342.  
  11343. 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));
  11344.  
  11345. 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));
  11346.  
  11347.  
  11348. 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));
  11349.  
  11350. 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));
  11351.  
  11352. 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));
  11353.  
  11354. 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 );
  11355. *
  11356. 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 ));
  11357.  
  11358. 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 ));
  11359.  
  11360. 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 );
  11361. *
  11362. 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 );
  11363. *
  11364. 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 );
  11365.  
  11366. QUITTER BLOC1 ;
  11367. FINSI ;
  11368. ******************************************************************************
  11369. SI ( EGA MOT1 'B4C' ) ;
  11370. TT1.'B4C' = TABLE ;
  11371.  
  11372. 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.);
  11373.  
  11374. * Valeurs rentrees le 30.01.1995 par R. Mitteau, d'apres le rapport
  11375. *'Determination de la conductivite thermique d'un depot de B4C sur
  11376. * un substrat cuivre' par D. Gosset, Rapport LEMA.DG.AD/95-003
  11377. * du 06.01.1995, valeurs extrapolees lineairement au dessus de 800C
  11378. * Valeurs representatives d'echantillons SNMI
  11379.  
  11380.  
  11381. 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 );
  11382.  
  11383. * Valeurs rentrees le 30.01.1995 par R. Mitteau, d'apres le rapport
  11384. *'Determination de la conductivite thermique d'un depot de B4C sur
  11385. * un substrat cuivre' par D. Gosset, Rapport LEMA.DG.AD/95-003
  11386. * du 06.01.1995, valeurs extrapolees lineairement au dessus de 800C
  11387. * Valeurs representatives d'echantillons SNMI
  11388.  
  11389.  
  11390. 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) ;
  11391.  
  11392. * Valeurs rentrees le 30.01.1995 par R. Mitteau, d'apres le rapport
  11393. *'Determination de la conductivite thermique d'un depot de B4C sur
  11394. * un substrat cuivre' par D. Gosset, Rapport LEMA.DG.AD/95-003
  11395. * du 06.01.1995, valeurs extrapolees lineairement au dessus de 800C
  11396. * Valeurs representatives d'echantillons SNMI
  11397.  
  11398. EVRHOC = (TT1.'B4C' . 'RHO') * ( TT1.'B4C' . 'C');
  11399.  
  11400. TT1.'B4C' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11401.  
  11402.  
  11403. *
  11404. 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);
  11405.  
  11406. 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 );
  11407.  
  11408. 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 );
  11409.  
  11410. * valeurs non connues prises identiques AU CUCRZR
  11411.  
  11412. 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. );
  11413.  
  11414. * TT1.'B4C' . 'H' = EVOL MANU
  11415. *'T'(PROG 0. 20. 200. 400. 500. 600.
  11416. * 800. 1000.)
  11417. * 'H' (PROG 1190.5E6 1190.5E6 1041.7E6 875.E6 729.2E6 500.E6
  11418. * 312.5E6 10.E6 );
  11419. QUITTER BLOC1 ;
  11420. FINSI ;
  11421. **********************************************************************
  11422. SI ( EGA MOT1 'BEHP' ) ;
  11423. * stands for BEryllium Hot Pressed
  11424. * valeurs rentrees le 18 mars 1994 par raphael MITTEAU
  11425. TT1.'BEHP' = TABLE ;
  11426.  
  11427. 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. ) ;
  11428. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11429. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11430. * valeurs pour 20 300 500 600, Best Fit pour les autres (log)
  11431. * donnee en Watt/ metre * Kelvin
  11432.  
  11433. 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);
  11434. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11435. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11436. * valeurs pour 20 100 500 1000, Best Fit pour les autres (puiss)
  11437. * donnee en [.]
  11438.  
  11439. TT1.'BEHP' . 'C' = EVOL MANU 'T' (PROG -200. 20. 100. 500. 1000. 1500. 4000. ) 'C' (PROG 1700. 1700. 2090. 2250. 2920. 3590. 3590. );
  11440. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11441. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11442. * valeurs pour 20 100 500 1000 1500 C
  11443. * donnee en Joule par Kelvin et par Kilo
  11444. * ce jeu de valeurs montre sans doute un PB vers 100 C
  11445.  
  11446. TT1.'BEHP' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 100. 500. 1000. 1500. 4000. ) 'RHO' (PROG 1850. 1850. 1826. 1711. 1565. 1420. 1420. );
  11447. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11448. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11449. * valeurs pour 20 et 1500 C, linearise pour les autres valeurs
  11450. * donnee en Kilo par metre cube
  11451.  
  11452. EVRHOC = (TT1.'BEHP' . 'RHO') * ( TT1.'BEHP' . 'C');
  11453.  
  11454. TT1.'BEHP' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11455.  
  11456.  
  11457. 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 );
  11458. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11459. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11460. * valeurs pour 20 600 et 800 C, Best Fit pour les autres (lineaire)
  11461. * donnee Pascal
  11462.  
  11463.  
  11464. TT1.'BEHP' . 'NU' = EVOL MANU 'T'(PROG -200. 20. 300. 500. 700. 900. 4000. ) 'NU' (PROG .08 .08 .08 .08 .08 .08 .08 );
  11465. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11466. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11467.  
  11468.  
  11469. 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 );
  11470. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11471. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11472. * valeurs pour 20 a 800 C corrigees,
  11473. * extrapolees a vue au dessus en fonction de Temp Fusion
  11474. * donnees exprimees en Pascal
  11475.  
  11476. TT1.'BEHP' . 'H' = EVOL MANU 'T' (PROG 0. 20. 200. 400. 500. 600. 800. 4000.) 'H' (PROG 8. * 400.E6 );
  11477. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11478. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11479. * valeur moyenne prise cste pour tout T
  11480. * donnees exprimees en Pascal
  11481.  
  11482. QUITTER BLOC1 ;
  11483. FINSI ;
  11484. **********************************************************************
  11485. SI ( EGA MOT1 'BE_ITER' ) ;
  11486. * stands for BEryllium hot pressed and sintered, fitted values
  11487. * valeurs rentrees le 29 mars 95 par J.F. Salavy
  11488.  
  11489. * source : ITER MATERIAL PROPERTIES HANDBOOK
  11490. * (draft, file code ITER-AL01-2101)
  11491. * envoyees par Ivi Schmid le 29/03/95 (excepte pour H)
  11492. * Pour Young, Poisson et yield, les polynomes donnent des valeurs
  11493. * de 0 a 800C. Les valeurs suivantes sont intuitees mais
  11494. * non exactes.
  11495.  
  11496. TT1.'BE_ITER' = TABLE ;
  11497.  
  11498. LTEMC1 = (PROG 20. PAS 39. 800.) ;
  11499.  
  11500. LCON1 = PROG ;
  11501. LRHO1 = PROG ;
  11502. LCSP1 = PROG ;
  11503. LALP1 = PROG ;
  11504. LYOU1 = PROG ;
  11505. LPOI1 = PROG ;
  11506. LYIE1 = PROG ;
  11507.  
  11508. I1 = 0 ;
  11509. REPE BOUC1 (DIME LTEMC1) ;
  11510. I1 = I1 + 1 ;
  11511. TEMPC1 = EXTR LTEMC1 I1 ;
  11512. VALCON1 = (-1.0104E-07 * (TEMPC1 ** 3.)) + ( 2.5429E-04 * (TEMPC1 ** 2.)) + (-2.6939E-01 * TEMPC1 ) + ( 1.8980E+02 ) ;
  11513. LCON1 = LCON1 ET (PROG VALCON1) ;
  11514.  
  11515. VALCSP1 = ( 1.2748E-06 * (TEMPC1 ** 3.)) + (-3.1125E-03 * (TEMPC1 ** 2.)) + ( 3.3358E+00 * TEMPC1 ) + ( 1.7418E+03 ) ;
  11516. LCSP1 = LCSP1 ET (PROG VALCSP1) ;
  11517.  
  11518. VALRHO1 = (-1.5139E-05 * (TEMPC1 ** 2.)) + (-6.9336E-02 * TEMPC1 ) + ( 1.8230E+03 ) ;
  11519. LRHO1 = LRHO1 ET (PROG VALRHO1) ;
  11520.  
  11521. VALALP1 = ( 3.4457E-15 * (TEMPC1 ** 3.)) + (-1.3462E-11 * (TEMPC1 ** 2.)) + ( 2.1892E-08 * TEMPC1 ) + ( 1.0822E-05 ) ;
  11522. LALP1 = LALP1 ET (PROG VALALP1) ;
  11523.  
  11524. VALYOU1 = (-7.6042E+02 * (TEMPC1 ** 3.)) + ( 3.8393E+05 * (TEMPC1 ** 2.)) + (-8.6726E+07 * TEMPC1 ) + ( 3.0961E+11 ) ;
  11525. LYOU1 = LYOU1 ET (PROG VALYOU1) ;
  11526.  
  11527. VALPOI1 = (-2.5E-05 * TEMPC1 ) + ( 0.0715 ) ;
  11528. LPOI1 = LPOI1 ET (PROG VALPOI1) ;
  11529.  
  11530. VALYIE1 = ( 8.5157E-02 * (TEMPC1 ** 3.)) + (-4.1428E+02 * (TEMPC1 ** 2.)) + ( 4.4811E+04 * TEMPC1 ) + ( 2.2464E+08 ) ;
  11531. LYIE1 = LYIE1 ET (PROG VALYIE1) ;
  11532.  
  11533. FIN BOUC1 ;
  11534.  
  11535. LTEMPT = (PROG -200.) ET LTEMC1 ET (PROG 1250. 10000.) ;
  11536.  
  11537. LCON1T = (PROG (EXTR LCON1 1)) ET LCON1 ET (PROG 60. 60.) ;
  11538. LCSP1T = (PROG (EXTR LCSP1 1)) ET LCSP1 ET (PROG 3540. 3540.) ;
  11539. LRHO1T = (PROG (EXTR LRHO1 1)) ET LRHO1 ET (PROG 1713. 1713.) ;
  11540. LALP1T = (PROG (EXTR LALP1 1)) ET LALP1 ET (PROG 2.4E-5 2.4E-5) ;
  11541. LYOU1T = (PROG (EXTR LYOU1 1)) ET LYOU1 ET (PROG 98.E+9 98.E+9) ;
  11542. LPOI1T = (PROG (EXTR LPOI1 1)) ET LPOI1 ET (PROG 0.0517 0.0517) ;
  11543. LYIE1T = (PROG (EXTR LYIE1 1)) ET LYIE1 ET (PROG 35.E+6 35.E+6) ;
  11544.  
  11545.  
  11546. TT1.'BE_ITER' . 'K' = EVOL MANU 'T' (LTEMPT) 'K'(LCON1T) ;
  11547.  
  11548. TT1.'BE_ITER' . 'C' = EVOL MANU 'T' (LTEMPT) 'C' (LCSP1T) ;
  11549.  
  11550. TT1.'BE_ITER' . 'RHO' = EVOL MANU 'T' (LTEMPT) 'RHO' (LRHO1T) ;
  11551.  
  11552. TT1.'BE_ITER' . 'ALPH' = EVOL MANU 'T' (LTEMPT) 'ALPH' (LALP1T) ;
  11553.  
  11554. TT1.'BE_ITER' . 'YOUN' = EVOL MANU 'T' (LTEMPT) 'YOUN' (LYOU1T) ;
  11555.  
  11556. TT1.'BE_ITER' . 'NU' = EVOL MANU 'T' (LTEMPT) 'NU' (LPOI1T) ;
  11557.  
  11558. TT1.'BE_ITER' . 'SIGY' = EVOL MANU 'T' (LTEMPT) 'SIGY' (LYIE1T) ;
  11559.  
  11560.  
  11561. EVRHOC = (TT1.'BE_ITER' . 'RHO') * ( TT1.'BE_ITER' . 'C');
  11562.  
  11563. TT1.'BE_ITER' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11564.  
  11565.  
  11566. TT1.'BE_ITER' . 'H' = EVOL MANU 'T' (PROG 0. 20. 200. 400. 500. 600. 800. 4000.) 'H' (PROG 8. * 400.E6 );
  11567. * source : MATERIAL DATA for predesign Analysis of In Vessel Components
  11568. * compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
  11569. * valeur moyenne prise cste pour tout T
  11570. * donnees exprimees en Pascal
  11571.  
  11572. QUITTER BLOC1 ;
  11573. FINSI ;
  11574.  
  11575. **********************************************************************
  11576. SI ( EGA MOT1 'MOLY' ) ;
  11577. TT1.'MOLY' = TABLE ;
  11578. *
  11579. 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. ) ;
  11580. *
  11581. QUITTER BLOC1 ;
  11582. FINSI ;
  11583. **********************************************************************
  11584. SI ( EGA MOT1 'TZM' ) ;
  11585. TT1.'TZM' = TABLE ;
  11586. *
  11587. 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. ) ;
  11588. 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. );
  11589.  
  11590. 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.);
  11591.  
  11592. EVRHOC = (TT1.'TZM'.'RHO') * ( TT1.'TZM'.'C');
  11593.  
  11594. TT1.'TZM' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11595.  
  11596. 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);
  11597.  
  11598. 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 );
  11599.  
  11600. 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 );
  11601.  
  11602. 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 );
  11603.  
  11604. 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 );
  11605. *
  11606. QUITTER BLOC1 ;
  11607. FINSI ;
  11608. **********************************************************************
  11609. SI ( EGA MOT1 'TUNGSTEN' ) ;
  11610. TT1.'TUNGSTEN' = TABLE ;
  11611. *
  11612. 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.) ;
  11613. *Valeurs The NET TEAM, Valeurs de references ITER au dela
  11614.  
  11615. 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. );
  11616. *Valeurs The NET TEAM, extrapolation lineaire au dela
  11617.  
  11618.  
  11619. 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.);
  11620. *Valeurs The NET TEAM, extrapolation lineaire au dela
  11621.  
  11622. EVRHOC = (TT1.'TUNGSTEN'.'RHO') * ( TT1.'TUNGSTEN'.'C');
  11623.  
  11624. TT1.'TUNGSTEN' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11625. QUITTER BLOC1 ;
  11626. FINSI ;
  11627. **********************************************************************
  11628. SI ( EGA MOT1 'OFHC' ) ;
  11629. TT1.'OFHC' = TABLE ;
  11630. *
  11631. 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. ) ;
  11632. * 'T' (PROG -500. 20. 200. 300. 400. 600. 2.5E3 )
  11633. * 'K'(PROG 387. 387. 365. 351.5 338. 312. 312.) ;
  11634. *
  11635.  
  11636. TT1.'OFHC' . 'C' = EVOL MANU 'T' (PROG -5000. 20. 200. 400. 600. 2.5E3) 'C'( PROG 380. 380. 390. 400. 415. 415.);
  11637.  
  11638. TT1.'OFHC' . 'RHO' = EVOL MANU 'T' (PROG -5000. 20. 200. 400. 600. 2.5E3) 'RHO'(PROG 8750. 8750. 8650. 8560. 8480. 8480.);
  11639.  
  11640. EVRHOC = (TT1.'OFHC' . 'RHO') * ( TT1.'OFHC' . 'C');
  11641.  
  11642. TT1.'OFHC' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11643.  
  11644. 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);
  11645.  
  11646. 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 );
  11647.  
  11648. 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 );
  11649.  
  11650. 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. );
  11651.  
  11652. 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 );
  11653. QUITTER BLOC1 ;
  11654. FINSI ;
  11655. **********************************************************************
  11656. SI ( EGA MOT1 'OFHCCYCL' ) ;
  11657. *
  11658. * Materiau entre le 19 septembre 1995 par R. Mitteau
  11659. *
  11660. * designation : Cuivre OFHC, proprietes mecaniques correspondant
  11661. * aux courbes d'ecrouissage cyclique
  11662. *
  11663. * Conductivite, rho, capacite calorifiques
  11664. * coefficient de Poisson prises identiques a OFHC
  11665. *
  11666. * Module d'young, SIGY et H d'apres
  11667. *
  11668. * High Temperature Torsional Low Cycle Fatigue of OFHC Copper
  11669. * Ahmet Aran and Dogan Erdun Gucer, Material Research Division,
  11670. * Marmara Research Institute...
  11671. * in Z. Metallkunde
  11672. *
  11673. * retravaille suivant CFP ...
  11674. *
  11675. *
  11676. *
  11677. TT1.'OFHCCYCL' = TABLE ;
  11678. *
  11679. 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. ) ;
  11680.  
  11681. TT1.'OFHCCYCL' . 'C' = EVOL MANU 'T' (PROG -5000. 20. 200. 400. 600. 2.5E3) 'C'( PROG 380. 380. 390. 400. 415. 415.);
  11682.  
  11683. TT1.'OFHCCYCL' . 'RHO' = EVOL MANU 'T' (PROG -5000. 20. 200. 400. 600. 2.5E3) 'RHO'(PROG 8750. 8750. 8650. 8560. 8480. 8480.);
  11684.  
  11685. EVRHOC = (TT1.'OFHCCYCL' . 'RHO') * ( TT1.'OFHCCYCL' . 'C');
  11686.  
  11687. TT1.'OFHCCYCL' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11688.  
  11689. 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 ));
  11690.  
  11691. 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 );
  11692.  
  11693. 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 );
  11694.  
  11695. 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. ));
  11696.  
  11697. 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. ));
  11698. QUITTER BLOC1 ;
  11699. FINSI ;
  11700. **********************************************************************
  11701. SI ( EGA MOT1 'INOX316L' ) ;
  11702. TT1.'INOX316L' = TABLE ;
  11703. *
  11704. TT1.'INOX316L' . 'K' = EVOL MANU 'T' (PROG -200. 20. 500. 800. 1000. 4.5E3 ) 'K'(PROG 15. 15. 21. 26. 28. 28.) ;
  11705.  
  11706. TT1.'INOX316L' . 'C' = EVOL MANU 'T' (PROG -200. 20. 500. 800. 1000. 2.5E3) 'C' ( PROG 480. 480. 560. 610. 650. 650.);
  11707.  
  11708. TT1.'INOX316L' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 500. 800. 1000. 2.5E3) 'RHO' (PROG 7850. 7850. 7850. 7850. 7850. 7850. );
  11709.  
  11710. EVRHOC = (TT1.'INOX316L' . 'RHO') * ( TT1.'INOX316L' . 'C');
  11711.  
  11712. TT1.'INOX316L' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11713.  
  11714. 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 );
  11715.  
  11716. 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 );
  11717.  
  11718. 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 );
  11719.  
  11720. 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 );
  11721. '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);
  11722. 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 );
  11723. QUITTER BLOC1 ;
  11724. FINSI ;
  11725. **********************************************************************
  11726. SI ( EGA MOT1 'GLIDCOP' ) ;
  11727. TT1.'GLIDCOP' = TABLE ;
  11728. *
  11729. TT1.'GLIDCOP' . 'K' = EVOL MANU 'T' (PROG -5000. 20. 200. 300. 500. 2.5E3 ) 'K'(PROG 348. 348. 325. 310.0 290. 290.) ;
  11730. * 'K'(PROG 391. 391. 385. 381. 377. 338. 312.) ;
  11731.  
  11732. 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.);
  11733.  
  11734. 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.);
  11735.  
  11736. EVRHOC = (TT1.'GLIDCOP' . 'RHO') * ( TT1.'GLIDCOP' . 'C');
  11737.  
  11738. TT1.'GLIDCOP' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11739.  
  11740. 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);
  11741.  
  11742. 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 );
  11743.  
  11744. 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 );
  11745.  
  11746. 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 );
  11747. * VALeurs prises egales au OFHC a controler
  11748.  
  11749. 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 );
  11750. QUITTER BLOC1 ;
  11751. FINSI ;
  11752. **********************************************************************
  11753. SI ( EGA MOT1 'OUTOKUMPU' ) ;
  11754. ***********************************************************************
  11755. TT1.'OUTOKUMPU' = TABLE ;
  11756. *
  11757. * seul valeur connue a 20 deg le reste pris proportionnellement a OFHC
  11758. 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.) ;
  11759. *OFHC
  11760. * 'T' (PROG -500. 20. 200. 300. 400. 600. 2.5E3 )
  11761. * 'K'(PROG 387. 387. 365. 351.5 338. 312. 312.) ;
  11762. QUITTER BLOC1 ;
  11763. FINSI ;
  11764. **********************************************************************
  11765. SI ( EGA MOT1 'CUCRZR' ) ;
  11766. TT1.'CUCRZR' = TABLE ;
  11767. *
  11768. *TITRE 'CUCRZR CONDUCTIVITY' ;
  11769. TT1.'CUCRZR' . 'K' = EVOL MANU 'T' (PROG -500. 20. 200. 300. 400. 600. 2.5E3 ) 'K'(PROG 343. 343. 351. 359. 359. 359. 312.) ;
  11770. TT1.'CUCRZR' . 'C' = EVOL MANU 'T' (PROG -200. 20. 200. 400. 600. 2.5E3) 'C' ( PROG 376. 376. 376. 376. 376. 376.);
  11771.  
  11772. TT1.'CUCRZR' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 200. 400. 600. 2.5E3) 'RHO'(PROG 8890. 8890. 8890. 8890. 8890. 8890.);
  11773.  
  11774. EVRHOC = (TT1.'CUCRZR' . 'RHO') * ( TT1.'CUCRZR' . 'C');
  11775.  
  11776. TT1.'CUCRZR' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11777.  
  11778. * valeurs non connues prises identiques CU dependent de l'etat du metal
  11779. 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);
  11780.  
  11781. 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);
  11782.  
  11783. 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 );
  11784.  
  11785. 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. );
  11786.  
  11787. 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 );
  11788. *
  11789. QUITTER BLOC1 ;
  11790. FINSI ;
  11791. **********************************************************************
  11792. SI ( EGA MOT1 'CUZR' ) ;
  11793. TT1.'CUZR' = TABLE ;
  11794. *valeurs non connues prises -10% au OFHC
  11795.  
  11796. TT1.'CUZR' . 'K' =EVOL MANU 'T' (PROG -200. 20. 200. 600. 1200. 2500. 2.5E3 ) 'K' (PROG 335. 335. 314. 270. 270. 270. 270.);
  11797.  
  11798. * valeurs non connues prises identiques au OFHC
  11799. TT1.'CUZR' . 'C' = EVOL MANU 'T' (PROG -200. 20. 200. 400. 600. 2.5E3) 'C'( PROG 380. 380. 390. 400. 415. 415.);
  11800.  
  11801. TT1.'CUZR' . 'RHO' = EVOL MANU 'T' (PROG -200. 20. 200. 400. 600. 2.5E3) 'RHO'(PROG 8750. 8750. 8650. 8560. 8480. 8480.);
  11802.  
  11803. EVRHOC = (TT1.'CUZR' . 'RHO') * ( TT1.'CUZR' . 'C');
  11804.  
  11805. TT1.'CUZR' . 'CapaVolu' = EVOL MANU 'T' ( EXTR EVRHOC ABSC 1 ) 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;
  11806. * valeurs non connues prises identiques AU CU
  11807. 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);
  11808.  
  11809. 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);
  11810.  
  11811. 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 );
  11812.  
  11813. * valeurs non connues prises identiques AU CUCRZR
  11814.  
  11815. 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. );
  11816.  
  11817. 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 );
  11818. QUITTER BLOC1 ;
  11819. FINSI ;
  11820. **********************************************************************
  11821. SI ( EGA MOT1 'AL25' ) ;
  11822. TT1.'AL25' = TABLE ;
  11823. *
  11824. *TITRE ' AL25 CONDUCTIVITY' ;
  11825. 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.) ;
  11826. QUITTER BLOC1 ;
  11827. FINSI ;
  11828. **********************************************************************
  11829. FIN BLOC1 ;
  11830. **********************************************************************
  11831. *
  11832. * Fin de la table de materiaux standarts
  11833. *
  11834. * Debut de la partie de la procedure qui retourne les donnees
  11835. *
  11836. **********************************************************************
  11837.  
  11838. SI (EXISTE TABT MOT1 ) ;
  11839. SI ( EXISTE (TABT. MOT1) MOT2 ) ;
  11840. EV1 = TABT . MOT1 . MOT2 ;
  11841. SINON ;
  11842. SI ( EXISTE TT1 MOT1 ) ;
  11843. SI ( EXISTE (TT1. MOT1) MOT2 ) ;
  11844. EV1 = TT1 . MOT1 . MOT2 ;
  11845. SINON ;
  11846. MESS '>>> Material ' MOT1 ' exists by you and in standard' ;
  11847. MESS '>>> the property ' MOT2 ' of the material ' MOT1 ' is not defined in your data' ' nor is it in satandard' ;
  11848. MESS '>>> Execution break-down by lack of data ' ;
  11849. ERRE 'MATERIAL' ;
  11850. FINSI ;
  11851. SINON ;
  11852. MESS '>>> MAT ' MOT1 ' exists by you but not in standard' ;
  11853. MESS '>>> the property ' MOT2 ' of the material ' MOT1 ' is not defined in your data' ;
  11854. MESS '>>> Execution break-down by lack of data ' ;
  11855. ERRE ' MATERIAL' ;
  11856. FINSI ;
  11857. FINSI ;
  11858. SINON ;
  11859. SI ( EXISTE TT1 MOT1 ) ;
  11860. SI ( EXISTE (TT1. MOT1) MOT2 ) ;
  11861. EV1 = TT1 . MOT1 . MOT2 ;
  11862. SINON ;
  11863. MESS '>>> The property ' MOT2 ' of the material ' MOT1 ' is not defined in standard' ;
  11864. ERRE 'MATERIAL' ;
  11865. FINSI ;
  11866. SINON ;
  11867. MESS '>>>> The material ' MOT1 ' is not defined in standard' ;
  11868. ERRE 'MATERIAL' ;
  11869. FINSI ;
  11870. FINSI ;
  11871.  
  11872. SI ( EXISTE VAL1 ) ;
  11873. EV1 = IPOL VAL1 (EXTR EV1 'ABSC' ) (EXTR EV1 'ORDO') ;
  11874. FINSI ;
  11875.  
  11876. SI ( EXISTE CHP1 ) ;
  11877. EV1 = IPOL CHP1 (EXTR EV1 'ABSC' ) (EXTR EV1 'ORDO') ;
  11878. FINSI ;
  11879. *
  11880. *
  11881. * Organisation :
  11882. * --------------
  11883. *
  11884. * La procedure est organisee en deux parties.
  11885. *
  11886. * La premiere partie est une table standart contenant les
  11887. * caracteristiques des materiaux usuels du groupe premiere paroi.
  11888. * Les donnees sont regroupes dans le bloc BLOC1.
  11889. *
  11890. * d'abord : materiaux de surface
  11891. * puis : materiaux intercalaires
  11892. * enfin : materiaux de structure
  11893. *
  11894. *
  11895.  
  11896. * Afin de ne pas surcharger la memoire de choses inutiles, un test
  11897. * permet de ne lire les donnees du materiau que s'il est effectivement
  11898. * appelle.
  11899. * Des que le materiau a ete lu, on sort du bloc, car il n'est pas
  11900. * necessaire de passer par tout les tests qui seront negatifs.
  11901. *
  11902. * Les caracteristiques sont definies sous forme d'evolutions.
  11903. *
  11904. * La deuxieme partie est la procedure proprement dite.
  11905. * Elle est organisee sous forme de tests SI-SINON-FINSI.
  11906.  
  11907. *-------------------------------------------------------------------*
  11908. FINPROC EV1 ;
  11909.  
  11910.  
  11911. 'DEBPROC' TELIGNSC MAIL_1*MAILLAGE CHP_1*CHPOINT P_DEB*POINT P_FIN*POINT CRIT*FLOTTANT ;
  11912. ********************************************************
  11913. *
  11914. * CETTE PROC. PERMET de reduire les valeurs du chpoint
  11915. *CHP_1 aux points les plus proche de la droite P_DEB P_FIN
  11916. * les points sont reperes suivant la distance a P_DEB
  11917. *la proc. rend une evolution donnant la valeur
  11918. *en fonction de la distance
  11919. *
  11920. * j. schlosser 8 4 92
  11921. *
  11922. ********************************************************
  11923. LBRI1 = MAIL_1 POIN 'DROIT' P_DEB P_FIN CRIT ;
  11924. i1 = 0 ;
  11925. opti elem seg2 ;
  11926. repeter bou4 (( NBNO LBRI1) - 1 ) ;
  11927. i1 = i1 + 1 ;
  11928. po1 = LBRI1 poin i1 ;
  11929. po2 = LBRI1 poin ( i1 + 1 ) ;
  11930. si ( i1 ega 1 ) ;
  11931. lbri2 = po1 d 1 po2 ;
  11932. sinon ;
  11933. lbri2 = lbri2 d 1 po2 ;
  11934. finsi ;
  11935. fin bou4 ;
  11936. XLBRI1 = COOR 1 LBRI2 ;
  11937. YLBRI1 = COOR 2 LBRI2 ;
  11938. NI1 = ( (( XLBRI1 - ( COOR 1 P_DEB )) ** 2 ) + (( YLBRI1 - ( COOR 2 P_DEB )) ** 2 ) ) ** 0.5 ;
  11939. EVI1 = evol chpo (REDU CHP_1 LBRI2 ) scal LBRI2 ;
  11940. EVI2 = evol chpo NI1 scal LBRI2 ;
  11941. EVIT1 = evol manu (EVI2 extr 'ORDO' 1 ) (EVI1 extr 'ORDO'1 ) ;
  11942. dess ( evI1 et evI2 ) ;
  11943. FINPROC EVIT1 ;
  11944.  
  11945. *EVIT1 = TELIGNSC VBRIQT CHT1 P01 O67 1.E-3 ;
  11946. **** @FLNORM
  11947.  
  11948. DEBPROC @FLNORM TAB1*TABLE ;
  11949. *
  11950. **************************************************
  11951. * Procedure (inspiree de @OMBRAGE) permettant de *
  11952. * recuperer les valeurs du flux normalise en *
  11953. * descendant les lignes de champ et en calculant *
  11954. * leur intersection avec le plan sur lequel la *
  11955. * valeur du flux normalise est connue. *
  11956. * Alain MOAL (Fevrier 2001) *
  11957. **************************************************
  11958. *
  11959. MESS '---------------------------------> calling @FLNORM';
  11960. *
  11961. *--------------- VARIABLES D'ENTREE :
  11962. MAIL1 = TAB1.LFLUX_EXTE ;
  11963. MAIL2 = TAB1.<MAILLAGE_FN ;
  11964. PASB1 = TAB1.<LONGUEUR_PAS_SANS_TEST ;
  11965. PASB2 = TAB1.<LONGUEUR_PAS_AVEC_TEST ;
  11966. *------------------------------------
  11967. *
  11968. *---- Champ magnetique sur le maillage "ombre"
  11969. TAB1.<MAILLAGE_B = MAIL1 ;
  11970. BR BZ BPHI = @MAGNB TAB1 ;
  11971. *
  11972. *---- signe pour descente de la ligne (+ si bz < 0)
  11973. TAB1.<CHAMP_SIGNE = BZ * (-1.) / (ABS BZ) ;
  11974. *
  11975. *---- distance a parcourir sans test d'intersection
  11976. CHZ = COOR 3 MAIL1 ;
  11977. Z0 = COOR 3 (MAIL2 POIN 1) ;
  11978. DMAX1 = (MINI (CHZ - Z0) 'ABS') * 0.9 ;
  11979. NBPAS1 = ENTIER ((DMAX1 + (PASB1/1000.))/PASB1) ;
  11980. *
  11981. *---- distance a parcourir avec test d'intersection
  11982. DMAX2 = (MAXI (CHZ - Z0) 'ABS') * 2. - DMAX1 ;
  11983. NBPAS2 = ENTIER ((DMAX2 + (PASB2/1000.))/PASB2) ;
  11984. *
  11985. *---- distance a parcourir
  11986. DMAX0 = (NBPAS1 * PASB1) + (NBPAS2 * PASB2) ;
  11987. *
  11988. *---- calcul exp(-delta/lambdaQ).ABS(b.n) aux points
  11989. *---- d'intersection avec une methode analytique
  11990. TAB1.<NOMBRE_PAS_SANS_TEST = NBPAS1 ;
  11991. TAB1.<NOMBRE_PAS_AVEC_TEST = NBPAS2 ;
  11992. TAB1.<DISTANCE_SANS_TEST = DMAX1;
  11993. TAB1.<DISTANCE_AVEC_TEST = DMAX2 ;
  11994. *
  11995. CHFNORM = @ANADES TAB1 ;
  11996. *
  11997. *---- Champ magnetique sur les points d'intersection
  11998. TAB1.<MAILLAGE_B = EXTR CHFNORM 'MAIL' ;
  11999. TITRE 'TEST : MAILLAGE INITIAL DEFORME ';
  12000. TRAC ((TAB1.<MAILLAGE_B) ET MAIL1 ET (TAB1.<GRILLE_B) ET (TAB1.<MAILLAGE_FN));
  12001. *
  12002. BR BZ BPHI = @MAGNB TAB1 ;
  12003. *
  12004. PHI = ATG (COOR 2 TAB1.<MAILLAGE_B) (COOR 1 TAB1.<MAILLAGE_B) ;
  12005. BX = BR * (COS PHI) - (BPHI * (SIN PHI));
  12006. BY = BR * (SIN PHI) + (BPHI * (COS PHI));
  12007. *AM*11/09/01*BX = BR * (COS PHI) + (BPHI * (SIN PHI));
  12008. *AM*11/09/01*BY = BR * (SIN PHI) - (BPHI * (COS PHI));
  12009. *
  12010. *---- Calcul de b.n sur le maillage "ombrant"
  12011. B_NORM = ((BX*BX) + (BY*BY) + (BZ*BZ))**0.5 ;
  12012. VBVN = (ABS BZ) / B_NORM ;
  12013. *
  12014. *---- calcul de exp (-delta/lambdaQ)
  12015. VAR1 = CHFNORM / VBVN ;
  12016. *
  12017. *---- on retrouve la forme initiale de TAB1.<S_OMBRE
  12018. FORM (TAB1.<DEPLACEMENT * (-1.)) ;
  12019. TITRE 'TEST : RETOUR FORME INITIALE' ;
  12020. TRAC ((TAB1.<MAILLAGE_B) ET MAIL1 ET (TAB1.<GRILLE_B) ET (TAB1.<MAILLAGE_FN));
  12021.  
  12022. MESS '>@FLNORM> distance covered :' TAB1.<LONGUEUR_PARCOURUE;
  12023.  
  12024. SI (EGA (TAB1.<LONGUEUR_CONNEXION_MAX) 0.) ;
  12025. MESS '>@FLNORM> no interception found';
  12026. SINON;
  12027. MESS '>@FLNORM> mini - maxi connection length' (mini TAB1.<CHAMP_DISTANCE) TAB1.<LONGUEUR_CONNEXION_MAX ;
  12028. FINSI;
  12029. *
  12030. MESS '---------------------------------> exiting @FLNORM';
  12031. FINPROC VAR1 ;
  12032.  
  12033. **** @FLUCRIT
  12034. DEBPROC @FLUCRIT TAB1*TABLE ;
  12035. *
  12036. * --- entrees
  12037. *
  12038. CHOIX = TAB1.'CHFCORRELATION';
  12039. NIVEAU = TAB1.'NIVEAU' ;
  12040. *
  12041. * --- racine
  12042. *
  12043. SI (NIVEAU >EG 4 ) ;
  12044. MESS '-----------------------------------> calling @FLUCRIT' ;
  12045. FINSI ;
  12046. * Calculs thermohydrauliques et bilans thermiques
  12047. * en attendant de les passer dans thersch1
  12048.  
  12049.  
  12050. *
  12051. * --- traitement
  12052. *
  12053. I1 = 1 ;
  12054. REPETER BOUC1 (DIME CHOIX) ;
  12055. ICHOIX = EXTR CHOIX I1 ;
  12056. LOGI1 = EGA ICHOIX 'BOWR' ;
  12057. LOGI2 = EGA ICHOIX 'TONG' ;
  12058. LOGI3 = EGA ICHOIX 'CELA' ;
  12059. LOGITOT1 = LOGI1 OU LOGI2 OU LOGI3 ;
  12060. SI (NON LOGITOT1) ;
  12061. ERRE '@FLUCRIT mot cle different de BOWR,TONG ou CELA' ;
  12062. FINSI ;
  12063. *
  12064. * --- Bowring72
  12065. *
  12066. SI (EGA ICHOIX 'BOWR') ;
  12067. TIN1 = TAB1.'T_IN' ;
  12068. PRESS1 = TAB1.'P_IN' ;
  12069. VITESS1 = TAB1.'V_IN' ;
  12070. EL = TAB1.'L_HEATED' ;
  12071. XL1 = TAB1.'WE_HEATED' ;
  12072. D1 = TAB1.'D_MAQUETTE' ;
  12073. YTWIST = TAB1.'TWIST_RATIO' ;
  12074. TTAPE = TAB1.'T_TAPE' ;
  12075. PI = 3.14159 ;
  12076. SI ( YTWIST EGA 0. ) ;
  12077. TAB1.DHC = D1 ;
  12078. S1 = PI * D1 * D1 / 4. ;
  12079. TAB1.DH = D1 ;
  12080. FACV = 1. ;
  12081. FACS = 1. ;
  12082. SINON ;
  12083. SI ( NON ( EXISTE TAB1 'N_CANAUX' )) ;
  12084. TAB1 . N_CANAUX = 2. ;
  12085. FINSI ;
  12086. SS2 = ( ( PI * D1 * D1 / 8.) - ( TTAPE * D1 / 2. ) ) ;
  12087. S1 = SS2 * TAB1 . N_CANAUX ;
  12088. QUAS = 4. * SS2 ;
  12089. PERI = ( ( PI * D1 / 2.) - TTAPE + D1 ) ;
  12090. TAB1.DH = QUAS / PERI ;
  12091. FINSI ;
  12092. TAB1.T_IN = TIN1;
  12093. TAB1.P_IN = PRESS1;
  12094. TAB1.V_IN = VITESS1;
  12095. @BOWRI72 TAB1 ;
  12096. QCHFW = TAB1.CHF ;
  12097. FINSI ;
  12098. *
  12099. * --- Tong75
  12100. *
  12101. SI (EGA ICHOIX 'TONG') ;
  12102. @TABEAU TAB1 ;
  12103. VIN = TAB1.V_IN ;
  12104. TIN = TAB1.T_IN ;
  12105. PRES1 = TAB1.P_LOCAL ;
  12106. D1 = TAB1.D_MAQUETTE ;
  12107. EL = TAB1.L_HEATED ;
  12108. XL1 = TAB1.WE_HEATED ;
  12109. TAB1.V_LOCAL = VIN ;
  12110. SI ( NON ( EXISTE TAB1 TWIST_RATIO ) ) ;
  12111. TAB1 . TWIST_RATIO = 0. ;
  12112. FINSI ;
  12113. YTWIST = TAB1 . TWIST_RATIO ;
  12114. SI ( NON ( EXISTE TAB1 T_TAPE ) ) ;
  12115. TAB1 . T_TAPE = 0. ;
  12116. FINSI ;
  12117. TTAPE = TAB1 . T_TAPE ;
  12118. QSURFE = TAB1.V_FLUMOY1 ;
  12119. TSAT = @IPOE PRES1 TAB1.EPTSAT ;
  12120. RHOIN = @IPOE TIN TAB1.ETRHOF ;
  12121. GIN = RHOIN * VIN ;
  12122. HIN = @IPOE TIN TAB1.ETHF ;
  12123. HSAT = @IPOE TSAT TAB1.ETHF ;
  12124. PI = 3.14159 ;
  12125. SI ( ( YTWIST EGA 0. ) ET ( EGA TAB1.HYPERVAP FAUX ) ) ;
  12126. TAB1.DHC = D1 ;
  12127. S1 = PI * D1 * D1 / 4. ;
  12128. TAB1.DH = D1 ;
  12129. FACV = 1. ;
  12130. FACS = 1. ;
  12131. TAB1.M_TONG = MOT 'TONG75' ;
  12132. * FACF = 1. ;
  12133. FINSI ;
  12134. SI ( NON ( EXISTE TAB1 HELI_WIRE ) ) ;
  12135. TAB1.HELI_WIRE = FAUX ;
  12136. FINSI ;
  12137. SI ( NON ( EXISTE TAB1 HYPERVAP ) ) ;
  12138. TAB1.HYPERVAP = FAUX ;
  12139. FINSI ;
  12140. SI ( ( YTWIST EGA 0. ) ET ( EGA TAB1.HELI_WIRE VRAI )) ;
  12141. S1 = PI * D1 * D1 / 4. ;
  12142. SM = PI * TAB1.WIRE_D * TAB1.WIRE_D / 4. ;
  12143. P1 = PI * D1 ;
  12144. PM = PI * TAB1.WIRE_D ;
  12145. TAB1.DH = 4. * ( S1 - SM ) / ( P1 + PM ) ;
  12146. PIS2Y = PI / ( 2 * TAB1.PITCH_WIRE ) ;
  12147. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  12148. * FACV = 1. ;
  12149. FACF = 1. ;
  12150. TAB1.M_TONG = MOT 'TONG75' ;
  12151. FINSI ;
  12152. *
  12153. SI ( NON ( EXISTE TAB1 HYPERVAP ) ) ;
  12154. TAB1.HYPERVAP = FAUX ;
  12155. FINSI ;
  12156. SI ( ( YTWIST EGA 0. ) ET ( EGA TAB1.HYPERVAP VRAI ) ) ;
  12157. SM = ( TAB1 . LARG_CANAL * TAB1 . HMIN_CANAL ) + ( 2. * ( TAB1 . LARG_ESP * TAB1 . HFIN ) ) ;
  12158. PM = TAB1 . LARG_CANAL + ( 2.* TAB1 . HMAX_CANAL ) + ( 2. * TAB1 . LARG_ESP ) + ( 2. * TAB1 . HFIN ) + TAB1 . LFIN ;
  12159. TAB1.DH = 4. * SM / PM ;
  12160. FACV = 1. ;
  12161. FACF = 1. ;
  12162. TAB1.HYP_SM = SM ;
  12163. FINSI ;
  12164. *
  12165. SI ( YTWIST > 0. ) ;
  12166. SI ( NON ( EXISTE TAB1 'N_CANAUX' )) ;
  12167. TAB1 . N_CANAUX = 2. ;
  12168. FINSI ;
  12169. SS2 = ( ( PI * D1 * D1 / 8.) - ( TTAPE * D1 / 2. ) ) ;
  12170. S1 = SS2 * TAB1 . N_CANAUX ;
  12171. QUAS = 4. * SS2 ;
  12172. PERI = ( ( PI * D1 / 2.) - TTAPE + D1 ) ;
  12173. TAB1.DH = QUAS / PERI ;
  12174. TAB1.DHC = 4. * ( ( PI * D1 * D1 / 4.) - ( TTAPE * D1 ) ) / ( ( PI * D1 ) - ( TTAPE * 2.) ) ;
  12175. PIS2Y = PI / ( 2. * YTWIST ) ;
  12176. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  12177. FACF = 1.15 ;
  12178. FACS = 1.67 ;
  12179. TAB1.M_TONG = MOT '1.67*TONG75' ;
  12180. FINSI ;
  12181. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  12182. HLOCAL = HIN + ( QSURFE * XL1 * EL / ( GIN * TAB1.HYP_SM ) ) ;
  12183. SINON ;
  12184. HLOCAL = HIN + ( QSURFE * XL1 * EL / ( GIN * S1 ) ) ;
  12185. FINSI ;
  12186. SI ( HLOCAL < HSAT ) ;
  12187. SI ( HLOCAL >EG HIN ) ;
  12188. TLOCAL = @IPOE HLOCAL TAB1.EHFT ;
  12189. SINON ;
  12190. MESS '>@FLUCRIT> HLOCAL < HIN ?????====== ' ;
  12191. ERREUR '>@FLUCRIT> HLOCAL < HIN' ;
  12192. FINSI ;
  12193. SINON ;
  12194. TLOCAL = TSAT ;
  12195. * HLOCAL = HSAT ;
  12196. FINSI ;
  12197. TAB1.'HLOCAL' = HLOCAL ;
  12198. @TONG75 TAB1 ;
  12199. QCHFW = TAB1.CHF ;
  12200. FINSI ;
  12201. *
  12202. * --- Celata94
  12203. *
  12204. SI (EGA ICHOIX 'CELA') ;
  12205. @CELAT94 TAB1 ;
  12206. QCHFW = TAB1.CHF ;
  12207. FINSI ;
  12208. *
  12209. * --- fin des appels
  12210. *
  12211. SI (EGA I1 1) ;
  12212. L_QCHFW = PROG QCHFW ;
  12213. SINON ;
  12214. L_QCHFW = L_QCHFW ET (PROG QCHFW) ;
  12215. FINSI ;
  12216. I1 = I1 + 1 ;
  12217. FIN BOUC1 ;
  12218.  
  12219. MESS '>@FLUCRIT> Critical Heat Flux output';
  12220. LIST L_QCHFW ;
  12221. *
  12222. * --- sorties
  12223. *
  12224. TAB1.'L_QCHFW' = L_QCHFW ;
  12225.  
  12226. SI (NIVEAU >EG 4 ) ;
  12227. MESS '-----------------------------------> exiting @FLUCRIT' ;
  12228. FINSI ;
  12229.  
  12230. FINPROC ;
  12231. **** @FLUXH
  12232. DEBPROC @FLUXH TAB1*TABLE ;
  12233. *---------------------------------------------------------------------
  12234. * Procedure @FLUXH
  12235. *---------------------------------------------------------------------
  12236. MESS '---------------------------------> calling @FLUXH';
  12237. V_DIM1 = VALEUR 'DIME' ;
  12238. S_TOT1 = TAB1.M_ILLAGE_TOT ;
  12239. COSDIR1 COSDIR2 COSDIR3 = @VNORM3D (EXTR TAB1.'MODELF' 'MAIL') (TAB1.LFLUX_EXTE) TAB1.'NIVEAU';
  12240. COTETF1 = COSDIR1 ;
  12241. SITETF1 = COSDIR2;
  12242. TETF1 = ATG SITETF1 ( COTETF1 + 1.E-12) ;
  12243.  
  12244. SI (EXISTE TAB1 'VAL_ANGLEI1');
  12245. MESS '>>>>@FLUXH Le flux d electrons est forcement selon OY ';
  12246. MESS '>>>>@FLUXH a l axe y, si autre angle tournez avec DEPL';
  12247. ERRE '>>>>@FLUXH TAB1 VAL_ANGLEI1 inoperant ici';
  12248. FINSI ;
  12249.  
  12250. *1 DDDDDDDDDD SI de niveau 1 : cas DIMENSION 2
  12251.  
  12252. SI ( V_DIM1 EGA 2) ;
  12253. MESS '>@FLUXH> 2D ';
  12254. VFON1 = TAB1.VPROFIL_W;
  12255. XFON1 = TAB1.XPROFIL_W;
  12256. LPAT1 = TAB1.LFLUX_EXTE;
  12257. LPAT1D = TAB1.LFLUX_EXTE_DESS ;
  12258. XLPAT1 = COOR 1 LPAT1;
  12259. XLPAT1D = COOR 1 LPAT1D;
  12260. XL_LPAT1 = ABS (( MAXI XLPAT1 ) - ( MINI XLPAT1 ));
  12261. VFON2 = ( IPOL XLPAT1 XFON1 VFON1 ) ;
  12262. EVV1 = EVOL CHPO XLPAT1 SCAL LPAT1D ;
  12263. *dess EVV1 ;
  12264. EVV2 = EVOL CHPO VFON2 SCAL LPAT1D ;
  12265. *dess EVV2 ;
  12266. VVFON2 = EXTR EVV2 ORDO 1 ;
  12267. XXPAT1 = EXTR EVV1 ORDO 1 ;
  12268. TITRE ' INCIDENT GUN FLUX PROFILE ' ;
  12269. dess ( EVOL MANU XXPAT1 VVFON2 ) ;
  12270. SOM1 = INTG ( EVOL MANU XXPAT1 VVFON2 ) ;
  12271. SOM1 = ABS ( MAXI SOM1 ) ;
  12272.  
  12273. * ajout RM le 27 10 95
  12274. SI (EGA (VALE MODE) 'AXIS') ;
  12275. MESS '>@FLUXH> mode axisymetrique' ;
  12276. SOM1 =(2. * 3.14159 * (INTG ( EVOL MANU XXPAT1 (VVFON2 * XXPAT1)))) ;
  12277. SOM1 = ABS ( MAXI SOM1 ) ;
  12278. FINSI ;
  12279. * fin locale de l ajout RM le 27 10 95
  12280.  
  12281. FACFM1 = SOM1 / XL_LPAT1 ;
  12282. MESS '>@FLUXH> VALEUR integrale DU PROFIL' SOM1;
  12283. MESS '>@FLUXH> LARGEUR MAQ. CHAUFFEE' (TAB1 . W_HEATED);
  12284. MESS '>@FLUXH> VALEUR moyenne DU PROFIL' FACFM1;
  12285. VPAT1 = VFON2 * SITETF1;
  12286. (MINI VPAT1) (MAXI VPAT1);
  12287. TAB1.'WE_HEATED_N'= XL_LPAT1 * (TAB1 . FSYM_X );
  12288. TAB1.'WE_HEATED'= XL_LPAT1 * (TAB1 . FSYM_X );
  12289. VPUI_1 = FACFM1 * XL_LPAT1;
  12290. TAB1.'V_FACFM1' = FACFM1;
  12291. MESS '>@FLUXH> direct integration' VPUI_1 ;
  12292.  
  12293. *
  12294. * --- test puissance incidente
  12295. *
  12296.  
  12297. * calcul apres utilisation de l operateur flux
  12298.  
  12299. FPAT1 = FLUX TAB1.'MODELF' VPAT1;
  12300. VPUI_2 = (MAXI (RESU FPAT1));
  12301. MESS '>@FLUXH> nodal intergration ' VPUI_2;
  12302.  
  12303. ERR_1 = VPUI_2 * 0.05;
  12304. SI( NON ( EGA VPUI_1 VPUI_2 ERR_1));
  12305. MESS '>@FLUXH> call the CONCEPTEUR ';
  12306. ERREUR 'POWER BALANCE';
  12307. SINON;
  12308. MESS '>@FLUXH> Ok Power Balance';
  12309. FINSI;
  12310.  
  12311. SOM1 = SOM1 * (EXTR TAB1.LIS_FLUX (DIME TAB1.LIS_FLUX));
  12312. SI (NON (EXISTE TAB1 'V_SOM1'));
  12313. TAB1.'V_SOM1' = SOM1;
  12314. SINON;
  12315. TAB1.'V_SOM1' = TAB1.'V_SOM1' + SOM1;
  12316. FINSI;
  12317. * 1 MMMMMMMM SINON de niveau 1 : cas DIMENSION 3
  12318. SINON ;
  12319.  
  12320. EXFLUX1 = TAB1.E_XPROFIL_W ;
  12321. EZFLUX1 = TAB1.E_ZPROFIL_W ;
  12322.  
  12323. SFLUX1 = TAB1.LFLUX_EXTE ;
  12324.  
  12325. XSFLUX1 = COOR 1 SFLUX1 ;
  12326. ZSFLUX1 = COOR 3 SFLUX1 ;
  12327.  
  12328. VXFLUX2 = ( @IPOE XSFLUX1 EXFLUX1 FIXE ) ;
  12329. VZFLUX2 = ( @IPOE ZSFLUX1 EZFLUX1 FIXE ) ;
  12330.  
  12331. VXZFLUX2 = VXFLUX2 * VZFLUX2 * COSDIR2 ;
  12332. PHFLUX1 = FLUX (TAB1.'MODELF') VXZFLUX2 ;
  12333. VMOY1 = MAXI ( ( RESU PHFLUX1) / ( MESU SFLUX1 ) ) ;
  12334. TAB1.'V_FACFM1'= VMOY1;
  12335. SOM1 = (MAXI (RESU PHFLUX1)) * (EXTR TAB1.LIS_FLUX (DIME TAB1.LIS_FLUX));
  12336. SI (NON (EXISTE TAB1 'V_SOM1'));
  12337. TAB1.'V_SOM1' = SOM1;
  12338. SINON;
  12339. TAB1.'V_SOM1' = TAB1.'V_SOM1' + SOM1;
  12340. FINSI;
  12341. VPAT1 = VXZFLUX2 / VMOY1 ;
  12342. *1 FFFFFFFFFF FINSI de niveau 1 : fin du test sur la dimension
  12343. FINSI ;
  12344. MESS '---------------------------------> exiting @FLUXH';
  12345. FINPROC VPAT1 ;
  12346.  
  12347. **** @FLUXQP
  12348. * Procedure @FLUXQP
  12349. *
  12350. *-----------------------------------------------------------------------
  12351. DEBPROC @FLUXQP TAB1*TABLE;
  12352. MESS '---------------------------------> calling @FLUXQP';
  12353. *
  12354. ****** ATTENTION --> Cette procedure ne tourne pour l'instant qu'en 2D
  12355.  
  12356. V_DIM1 = VALEUR 'DIME' ;
  12357. SI ( V_DIM1 EGA 3) ;
  12358. MESS '@FLUXQP ne tourne pas en 3D';
  12359. ERRE 'Dimension';
  12360. FINSI;
  12361.  
  12362. TAC1 = TABLE;
  12363. TAC1.1 = 'MARQ TRIA ';
  12364. TAC1.2 = 'MARQ TRIB ';
  12365. TAC1.3 = 'MARQ ETOI ';
  12366. TAC1.4 = 'MARQ LOSA ';
  12367. TAC1.5 = 'MARQ CROI ';
  12368. TAC1.6 = 'MARQ PLUS ';
  12369. S_TOT1 = TAB1.M_ILLAGE_TOT ;
  12370. LPAT1 = TAB1.LFLUX_EXTE ;
  12371. LPAT1D = TAB1.LFLUX_EXTE_DESS ;
  12372. COSDIR1 COSDIR2 COSDIR3 = @VNORM3D (EXTR TAB1.'MODELF' 'MAIL') LPAT1 TAB1.'NIVEAU';
  12373. COTETF1 = COSDIR1;
  12374. SITETF1 = COSDIR2;
  12375. TETF1 = ATG SITETF1 ( COTETF1 + 1.E-12) ;
  12376. SI (EXISTE TAB1 'VAL_ANGLEI1');
  12377. SI (EXISTE TAB1 'CENTRE_PLASMA');
  12378. ERREUR 'on ne peut avoir VAL_ANGLEI1 et CENTRE_PLASMA ' ;
  12379. SINON;
  12380. SINPA1 = COS ( (TETF1 * -1.) + (TAB1.'VAL_ANGLEI1'));
  12381. SIALPHA1 = ABS ( COS (TAB1.'VAL_ANGLEI1'));
  12382. COALPHA1 = ABS ( SIN (TAB1.'VAL_ANGLEI1'));
  12383. XXPAT1 = ABS ((COOR 1 LPAT1) - (COOR 1 TAB1.'PT_TGPLASMA'));
  12384. YYPAT1 = ABS ((COOR 2 LPAT1) - (COOR 2 TAB1.'PT_TGPLASMA'));
  12385. XLPAT1 = (XXPAT1*COALPHA1) + (YYPAT1*SIALPHA1);
  12386. XLPAT3 = XLPAT1;
  12387. FINSI;
  12388. SINON;
  12389. SI (NON (EXISTE TAB1 'CENTRE_PLASMA'));
  12390. ERREUR 'vous n avez pas donne TAB1.VAL_ANGLEI1';
  12391. SINON;
  12392. LOG1 = EGA (COOR 1 TAB1.'CENTRE_PLASMA') (COOR 1 TAB1.'PT_TGPLASMA') 1.E-6;
  12393. SI ( NON LOG1);
  12394. ERREUR ' COOR 1 CENTRE_PLASMA ET PT_TGPLASMA DIFFERENTS ' ;
  12395. FINSI;
  12396. R0 = (COOR 2 TAB1.'CENTRE_PLASMA') - (COOR 2 TAB1.'PT_TGPLASMA');
  12397. XXPAT1 = ((COOR 1 LPAT1) - (COOR 1 TAB1.'CENTRE_PLASMA')) ;
  12398. YYPAT1 = -1. * ((COOR 2 LPAT1) - (COOR 2 TAB1.'CENTRE_PLASMA')) ;
  12399. RXY = ((XXPAT1 * XXPAT1)+(YYPAT1 * YYPAT1))** 0.5 ;
  12400. ALPH1 = ATG XXPAT1 (YYPAT1 + 1.E-6) ;
  12401. XLPAT1 = RXY - R0 ;
  12402. SINPA1 = SIN ( ALPH1 + 90. - TETF1 ) ;
  12403. MASP1 = XXPAT1 MASQUE 'EGSUPE' 0. ;
  12404. MASM1 = XXPAT1 MASQUE 'INFERIEUR' 0. ;
  12405. XLPAT3 = (XLPAT1 * MASP1) - (XLPAT1 * MASM1) ;
  12406. FINSI;
  12407. FINSI;
  12408. MLAMB1 = ( TAB1 . 'LAMDAQ' ) * -1. ;
  12409. ELPAT1 = EXP ( XLPAT1 / MLAMB1 ) ; ;
  12410. VPAT1 = ELPAT1 * (ABS SINPA1) ;
  12411. *********** cas LAMBDAQ VPAT1 = exp*sinus
  12412. TAC1.TITRE = TABLE ;
  12413.  
  12414. *TITRE 'SIN(teta)' ;
  12415. EV1 = EVOL CHPO SINPA1 SCAL LPAT1D ;
  12416. *TITRE 'EXP(-DL/LAMB)' ;
  12417. EV2 = EVOL CHPO ELPAT1 SCAL LPAT1D ;
  12418. *TITRE 'SIN(teta)*EXP(-DL/LAMB)' ;
  12419. EV3 = EVOL CHPO VPAT1 SCAL LPAT1D ;
  12420. TAC1.1 = 'MARQ TRIA REGU ' ;
  12421. TAC1.TITRE.1 = 'SIN(teta)';
  12422. TAC1.2 = 'MARQ TRIB REGU TITR SIN(teta)' ;
  12423. TAC1.TITRE.2 = 'EXP(-DL/LAMB)';
  12424. TAC1.3 = 'MARQ ETOI REGU TITR EXP(-DL/LAMB)' ;
  12425. TAC1.TITRE.3 = 'SIN(teta)*EXP(-DL/LAMB)' ;
  12426. *TAC1.4 = 'MARQ LOSA REGU TITR EXP(-DL/LAMB)' ;
  12427. *TAC1.5 = 'MARQ CROI REGU TITR SIN(teta)*EXP(-DL/LAMB)' ;
  12428. *TAC1.6 = 'MARQ PLUS REGU TITR SIN(teta)*EXP(-DL/LAMB)' ;
  12429. TITRE 'SIN,EXP,SIN*EXP' ;
  12430. DESS ( EV1 ET EV2 ET EV3 ) LEGE TAC1;
  12431. MESS ' MIN MAX DE EXP*SINa ' (MINI VPAT1) (MAXI VPAT1);
  12432. TITRE 'EXP(-DL/LAMB) fonction de DL ' ;
  12433. EV4 = EVOL CHPO XLPAT3 SCAL LPAT1D ;
  12434. EV5 = ( EVOL MANU (EXTR EV4 ORDO 1) (EXTR EV2 ORDO 1));
  12435. TITRE 'EXP(-DL/LAMB) fonction de DL ';
  12436. DESS EV5 LEGE;
  12437. SOM1 = INTG EV5 ;
  12438. *********** cas LAMBDAQ VPAT1 = exp*sinus
  12439. *********** cas LAMBDAQ SOM1 = somme ( exp*sinus)
  12440. *********** cas LAMBDAQ FACFM1 = SOM1 / largeur
  12441. SOM1 = ABS (MAXI SOM1);
  12442. MESS '>@FLUXQP> VALEUR integrale DU PROFIL' SOM1;
  12443. MESS '>@FLUXQP> LARGEUR MAQ. CHAUFFEE' (TAB1 . W_HEATED );
  12444. XL_LPAT1 = ( ABS (( MAXI XLPAT1 ) - ( MINI XLPAT1 )));
  12445. FACFM1 = SOM1 / XL_LPAT1;
  12446. MESS '>@FLUXQP> LARGEUR vue du plasma' XL_LPAT1;
  12447. MESS '>@FLUXQP> VALEUR moyenne DU PROFIL' FACFM1;
  12448.  
  12449. SI (EXISTE TAB1 'LAMDAQ2');
  12450. LPAT2 = TAB1.LFLUX_EXT2 ;
  12451. LPAT2D = TAB1.LFLUX_EXT2 ;
  12452. COSDIR1 COSDIR2 COSDIR3 = @VNORM3D S_TOT1 LPAT2 TAB1.'NIVEAU';
  12453. COTETF2 = COSDIR1 * 1. ;
  12454. SITETF2 = COSDIR2 * 1. ;
  12455. COTETF1 = @ET COTETF1 COTETF2 ;
  12456. SITETF1 = @ET SITETF1 SITETF2 ;
  12457. TETF2 = ATG SITETF2 ( COTETF2 + 1.E-12) ;
  12458. MESS '>>>>> 3B>>>>>>' ;
  12459. SINPA2 = COS ( (TETF2 * -1.) + (TAB1.'VAL_ANGLEI2'));
  12460. SIALPHA2 = ABS ( COS (TAB1.'VAL_ANGLEI2')) ;
  12461. COALPHA2 = ABS ( SIN (TAB1.'VAL_ANGLEI2'));
  12462. XXPAT2 = ABS ((COOR 1 LPAT2) - (COOR 1 TAB1.'PT_TGPLASMA'));
  12463. YYPAT2 = ABS ((COOR 2 LPAT2) - (COOR 2 TAB1.'PT_TGPLASMA'));
  12464. XLPAT2 = (XXPAT2*COALPHA2) + (YYPAT2*SIALPHA2);
  12465. MLAMB2 = ( TAB1 . 'LAMDAQ2' ) * -1.;
  12466. ELPAT2 = EXP ( XLPAT2 / MLAMB2 );
  12467. VPAT2 = ELPAT2 * SINPA2;
  12468. VPAT2 = VPAT2 + (( REDU VPAT2 TAB1.'PT_TGPLASMA') * -1.);
  12469. VPAT1 = VPAT2 + VPAT1;
  12470. * VPAT1 = VPAT2;
  12471. TITRE 'SIN(teta)*EXP(-DL/LAMB)';
  12472. TAC1 = TABLE ;
  12473. TAC1.1 = 'MARQ TRIA ' ;
  12474. TAC1.2 = 'MARQ TRIB ' ;
  12475. TAC1.3 = 'MARQ ETOI ' ;
  12476. TAC1.4 = 'MARQ LOSA ' ;
  12477. TITRE 'SIN(teta)';
  12478. EV1 = EVOL CHPO SINPA2 SCAL LPAT2D;
  12479. TITRE 'EXP(-DL/LAMB)' ;
  12480. EV2 = EVOL CHPO ELPAT2 SCAL LPAT2D ;
  12481. TITRE 'SIN(teta)*EXP(-DL/LAMB)';
  12482. EV3 = EVOL CHPO VPAT2 SCAL LPAT2D ;
  12483. EV4 = EVOL CHPO XLPAT2 SCAL LPAT2D ;
  12484. DESS ( EV1 ET EV2 ET EV3 ) ;
  12485. MESS ' MIN MAX DE EXP*SIN22 ' (MINI VPAT2) (MAXI VPAT2);
  12486. TITRE 'EXP(-DL/LAMB) fonction de DL, ligne 2 ';
  12487. EV5 = (EVOL MANU (EXTR EV4 ORDO 1) (EXTR EV2 ORDO 1));
  12488. TAC1.1 = 'MARQ TRIA TITRE EXP(-DL/LAMB)' ;
  12489. TAC1.2 = 'MARQ TRIB TITRE EXP(-DL/LAMB)' ;
  12490. DESS EV5 LEGE TAC1;
  12491. SOM1 = SOM1 + (ABS ( MAXI (INTG EV5) )) ;
  12492. MESS '>CFLUX_TO> VALEUR integrale DU PROFIL' SOM1;
  12493. MESS '>CFLUX_TO> LARGEUR MAQ. CHAUFFEE' (TAB1 . W_HEATED);
  12494. XL_LPAT2 = ( ABS (( MAXI XLPAT2 ) - ( MINI XLPAT2 )));
  12495. XL_LPAT1 = XL_LPAT1 + XL_LPAT2;
  12496. FACFM1 = SOM1 / XL_LPAT1;
  12497. MESS '>CFLUX_TO> VALEUR moyenne DU PROFIL' FACFM1;
  12498. FINSI;
  12499.  
  12500. TAB1.'WE_HEATED_R'= XL_LPAT1 * (TAB1.FSYM_X);
  12501. TAB1.'WE_HEATED'= XL_LPAT1 * (TAB1.FSYM_X);
  12502. VPUI_1 = FACFM1 * XL_LPAT1;
  12503. MESS ' PUIS. LINEIQUE PARTIE MAILLEE ON DOIT TROUVER ' VPUI_1 ;
  12504. FPAT1 = FLUX (TAB1.'MODELF') VPAT1 ;
  12505. VPUI_2 = ( MAXI ( RESU FPAT1 ));
  12506. ERR_1 = VPUI_2 * 0.05;
  12507. MESS ' >>>>> RESULTANTE FLUX INCIDENT >>>>' VPUI_2;
  12508. SI( NON ( EGA VPUI_1 VPUI_2 ERR_1));
  12509. MESS '>> @FLUXQP: voir le CONCEPTEUR ';
  12510. * ERREUR 'BILAN DES PUISSANCES';
  12511. FINSI;
  12512.  
  12513. SOM1 = SOM1 * (EXTR TAB1.LIS_FLUX (DIME TAB1.LIS_FLUX));
  12514. SI (NON (EXISTE TAB1 'V_SOM1'));
  12515. TAB1.'V_SOM1' = SOM1;
  12516. SINON;
  12517. TAB1.'V_SOM1' = TAB1.'V_SOM1' + SOM1;
  12518. FINSI;
  12519. TAB1.'V_FACFM2'= FACFM1;
  12520. MESS '---------------------------------> Sortie de @FLUXQP';
  12521.  
  12522. FINPROC VPAT1;
  12523.  
  12524. **** @FLUXTOT
  12525. *-----------------------------------------------------------------------
  12526. * Procedure @FLUXTOT
  12527. *-----------------------------------------------------------------------
  12528. DEBPROC @FLUXTOT TAB1*TABLE;
  12529. *
  12530. ***********************************************************************
  12531. * @FLUXTOT developpee par Nicolas URAGO (avr-sept 1994) *
  12532. * largement revisitee par Jacques SCHLOSSER et Alain MOAL (aout 1995) *
  12533. ***********************************************************************
  12534. ******* ATTENTION --> Cette procedure ne tourne qu'en 3D et ne peut
  12535. * traiter que des cas de limiteurs plancher car
  12536. * Z (point tangent) = Z (centre du plasma)
  12537. *
  12538. MESS '---------------------------------> calling @FLUXTOT';
  12539. *
  12540. *-------------------- VARIABLES D'ENTREE
  12541. LPAT1 = TAB1.LFLUX_EXTE ;
  12542. GRP1 = TAB1.GRAND_RAYON ;
  12543. IMESS = TAB1.'NIVEAU' ;
  12544. PTG = TAB1.'PT_TGPLASMA';
  12545. MODEL0 = TAB1.'MODELF' ;
  12546. LAMBQ = TAB1.LAMDAQ ;
  12547. LISFLU = TAB1.LIS_FLUX ;
  12548. OEIL0 = TAB1.VIEW_P ;
  12549. *
  12550. SI (EXISTE TAB1 ANGLE_DEC) ;
  12551. PSI = TAB1.ANGLE_DEC ;
  12552. SINON;
  12553. PSI = 0.0 ;
  12554. FINSI;
  12555. *---------------------------------------
  12556. *
  12557. *---- On calcule pour chaque point de LPAT1, les coordonnees
  12558. *---- de son'centre plasma'.
  12559. XP1 = COOR 1 LPAT1 ;
  12560. YP1 = COOR 2 LPAT1 ;
  12561. ZP1 = COOR 3 LPAT1 ;
  12562. GRAYP1 = (XP1**2 + (YP1**2))**0.5 ;
  12563. XCP1 = XP1 * GRP1 / GRAYP1 ;
  12564. YCP1 = YP1 * GRP1 / GRAYP1 ;
  12565. *
  12566. AUX1 = ((XCP1 - XP1)**2 + ((YCP1 - YP1)**2))**0.5;
  12567. BETA1 = ATG (AUX1/ZP1) ;
  12568. ALPHA2 = ATG YCP1 XCP1 ;
  12569. *
  12570. *---- le vecteur tangent aux lignes de champ B est orthogonal
  12571. *---- a V = P1CP1
  12572. VX1 = XCP1 - XP1 ;
  12573. VY1 = YCP1 - YP1 ;
  12574. VZ1 = ZP1 * -1. ;
  12575. *
  12576. *---- B appartient au plan defini par les vecteurs K (0, 0, 1) et U
  12577. *UX1 = SIN (PSI + ALPHA2) ;
  12578. *UY1 = (COS (PSI + ALPHA2)) * -1. ;
  12579. *UZ1 = UX1 * 0. ;
  12580. *
  12581. UX1 = SIN (PSI - ALPHA2) ;
  12582. UY1 = COS (PSI - ALPHA2) ;
  12583. UZ1 = UX1 * 0. ;
  12584. *
  12585. *---- calcul de B
  12586. BZ = ((VZ1*UX1)**2 + ((VZ1*UY1)**2)) / ((VX1*UX1 + (VY1*UY1))**2) + 1. ;
  12587. BZ = BZ**(-0.5) * -1.;
  12588. BY = BZ * (VZ1*UY1) /(VX1*UX1 + (VY1*UY1)) * -1. ;
  12589. BX = BY * UX1 / UY1 ;
  12590. *
  12591. *---- Calcul du produit scalaire : VECTEUR TANGENT . NORMALE
  12592. NX NY NZ = @VNORM3D (EXTR MODEL0 'MAIL') LPAT1 IMESS ;
  12593. COS_BN = ABS ((BX*NX) + (BY*NY) + (BZ*NZ)) ;
  12594. *
  12595. *---- Coordonnees du point de tangence
  12596. XREF1 = COOR 1 PTG ;
  12597. YREF1 = COOR 2 PTG ;
  12598. ZREF1 = COOR 3 PTG ;
  12599. *
  12600. *---- Centre du plasma au dessus du point de tangence
  12601. XCREF1 = XREF1 * GRP1 / ((XREF1**2 + (YREF1**2))**0.5);
  12602. YCREF1 = YREF1 * GRP1 / ((XREF1**2 + (YREF1**2))**0.5);
  12603. *
  12604. *---- DREF1 est le petit rayon du plasma
  12605. DREF1 = (((XREF1-XCREF1)**2) + ((YREF1-YCREF1)**2) + (ZREF1**2))**.5;
  12606. DIST1 = (((XP1 - XCP1)**2) + ((YP1 - YCP1)**2) + (ZP1**2))**.5;
  12607. *
  12608. *---- Distance a la DSMF
  12609. LDEC1 = DIST1 - DREF1 ;
  12610. *
  12611. *---- Calcul du profil de flux
  12612. VPAT1 = COS_BN * (EXP (LDEC1/(-1.*LAMBQ))) ;
  12613. VFP1 = FLUX MODEL0 VPAT1 ;
  12614. *
  12615. *---- Visualisations
  12616. ARET0 = ARETE LPAT1 ;
  12617. TITRE '@FLUXTOT : B.N = COSINUS OF THE INCIDENCE ANGLE';
  12618. TRAC OEIL0 COS_BN LPAT1 ARET0;
  12619. TITRE '@FLUXTOT : TANGENT VECTOR TO THE MAGNETIC LINE';
  12620. VB = @CVECT BX BY BZ LPAT1 VERT;
  12621. TRAC OEIL0 VB LPAT1 ;
  12622. TITRE '@FLUXTOT : DISTANCE TO THE LCFS' ;
  12623. TRAC OEIL0 LDEC1 LPAT1 ARET0;
  12624. TITRE '@FLUXTOT : PROFILE OF THE INCIDENT FLUX' ;
  12625. TRAC OEIL0 VPAT1 LPAT1 ARET0;
  12626. *
  12627. *-------------------- VARIABLES EN SORTIE
  12628. *---- flux moyen et puissance
  12629. TAB1.V_SOM1 = (EXTR LISFLU (DIME LISFLU)) * (MAXI (RESU VFP1));
  12630. TAB1.V_FACFM2 = (MAXI (RESU VFP1)) / (MESU LPAT1) ;
  12631. *-----------------------------------------
  12632. *
  12633. MESS '---------------------------------> exiting @FLUXTOT';
  12634. FINPROC VPAT1 ;
  12635.  
  12636. **** @FLUXX
  12637. DEBPROC @FLUXX TAB1*TABLE;
  12638. *----------------------------------------------------------------------
  12639. * Procedure de calcul de flux incident dans differents cas de geometrie
  12640. *
  12641. * TAB1.DEPOT_FLUX = MOT 'CANON' : CANON A ELECTRON @FLUXH
  12642. * MOT 'PLASMAFLUX_2D' : PLASMA ou flux 2D @FLUXQP
  12643. * MOT 'PLASMA_3D' : PLASMA, 3D @FLUXTOT
  12644. * MOT 'FLUX_3D' : FLUX 3D directions // @FLUX_3D
  12645. * MOT 'RIPPLE_SHIFT' : 2D ou 3D avec @TOKAFLU
  12646. * RIPPLE et SHIFT
  12647. * de SHAFRANOV
  12648. *
  12649. *'PLASMAFLUX_2D' regroupe en fait 3 cas :
  12650. * plasma en coupe poloidale (petit cercle)
  12651. * plasma en coupe toroidale (bande)
  12652. * plasma modelise par des lignes //
  12653. *js 26/3/96
  12654. *js TAB1.LIS_FLUX est une des entrees il faudrait pour plus de clarte
  12655. *js TAB1.LIS_FLUXM cas du canon a electron
  12656. *js TAB1.LIS_FLUX = TAB1.LIS_PHI0 cas des PLASMAS
  12657. *js
  12658. *js
  12659. *js il sort de la procedure
  12660. *js
  12661. *js TAB1.'VFPAT1'.INT1 chpoint du chargement total
  12662. *js
  12663. *js TAB1.'LIS_FLUMOYEN' liste des flux moyens en principe au sens de
  12664. *js la MESU TAB1.LFLUX_EXTE (mais ce qui n'est pas bon c'est que parfois
  12665. *js c'est pris sur la largeur de srape off layer intercepte
  12666. *js
  12667. *js
  12668. *js TAB1.'LIS_PUI1' c'est en principe TAB1.'LIS_FLUMOYEN'
  12669. *(MESUTAB1.LFLUX_EXTE)
  12670. *js
  12671. *js il faudrait tjs faire dans cette procedure
  12672. *js
  12673. *js FPAT1 = FLUX (TAB1 . 'MODELF') TAB1.'VFPAT1'.INT1 ;
  12674. *js TAB1.'LIS_PUI1' = TAB1.'LIS_PUI1' ET PROG ((RESU FPAT1)) ;
  12675. *js TAB1.'LIS_FLUMOYEN' = TAB1.'LIS_PUI1' /(MESU TAB1.LFLUX_EXTE);
  12676. *js
  12677. *js une fois ces changements faits proprement
  12678. *js
  12679. *js attention aux modif dans TPERM (facile) PPERM
  12680. *js (complexe mais ca devrait eclaicir)
  12681. *js et TTRANS PTRANS
  12682. *js et dans les procedures appelees par FLUXX
  12683. *js une fois ces modifs faites il est facile de rajouter un flux additionnel
  12684. *js TAB1.'VFPAT1'.INT1 = TAB1.'VFPAT1'.INT1 + TAB1.FLUX_ADDITIONNEL
  12685. *js
  12686. *js
  12687. *js
  12688. *MESS 'JS 220296 Attention il faut maintenant concatener';
  12689. *MESS 'cat fluxx.procedur fluxh.procedur fluxqp.procedur' ;
  12690. *MESS ' fluxtot.procedur flux_3d.procedur > fluxx.bidon' ;
  12691. *MESS 'et utiliser fluxx.bidon a la place de fluxx.procedur';
  12692. *MESS 'en cas de pb l ancienne procedure est disponible dans';
  12693. *MESS ' ~schlos/fluxx.procedur.220296.old';
  12694. *
  12695. MESS ' ';
  12696. *
  12697. * --- entrees
  12698. *
  12699. NIVEAU = TAB1.'NIVEAU';
  12700. SI (NIVEAU >EG 4) ;
  12701. MESS '---------------------------------> calling @FLUXX';
  12702. FINSI ;
  12703.  
  12704. ***************
  12705. * ON TESTE SI IL Y A UN FLUX OU DEUX FLUX A SUPERPOSER.
  12706. SI (EXISTE TAB1 LIS_FLUXP);
  12707. SI (EGA (DIME TAB1.LIS_FLUX) (DIME TAB1.LIS_FLUXP));
  12708. BOOL1 = VRAI;
  12709. TMP = TABLE;
  12710. SINON;
  12711. ERRE 'TAB1.LIS_FLUX et TAB1.LIS_FLUXP ne sont pas de meme longueur';
  12712. FINSI;
  12713. SINON;
  12714. BOOL1 = FAUX;
  12715. FINSI;
  12716.  
  12717. ************
  12718. * CONSTRUCTION DE VPAT1 : PROFIL DU FLUX INCIDENT
  12719. *
  12720. SI (EXISTE TAB1 DEPOT_FLUX);
  12721. IVERIF = 0 ;
  12722. SI (EGA TAB1.DEPOT_FLUX 'CANON');
  12723. VPAT1 = @FLUXH TAB1;
  12724. IVERIF = 1 ;
  12725. FINSI ;
  12726. SI (EGA TAB1.DEPOT_FLUX 'PLASMAFLUX_2D');
  12727. VPAT1 = @FLUXQP TAB1;
  12728. IVERIF = 1 ;
  12729. SI BOOL1;
  12730. TMP = TAB1.LIS_FLUX;
  12731. TAB1.LIS_FLUX = TAB1.LIS_FLUXP;
  12732. VPAT2 = @FLUXH TAB1;
  12733. TAB1.LIS_FLUX = TMP;
  12734. FINSI;
  12735. FINSI ;
  12736. SI (EGA TAB1.DEPOT_FLUX 'FLUX_3D');
  12737. VPAT1 = @FLUX_3D TAB1;
  12738. IVERIF = 1 ;
  12739. FINSI ;
  12740. SI (EGA TAB1.DEPOT_FLUX 'PLASMA_3D');
  12741. VPAT1 = @FLUXTOT TAB1;
  12742. VFP1 = FLUX TAB1.'MODELF' VPAT1 ;
  12743. IVERIF = 1 ;
  12744. FINSI ;
  12745. SI (EGA TAB1.DEPOT_FLUX 'RIPPLE_SHIFT');
  12746. VPAT1 = @TOKAFLU TAB1;
  12747. SI (EXISTE TAB1 <PENETRATION) ;
  12748.  
  12749. SI (TAB1.<PENETRATION) ;
  12750. * ---- Prise en compte de la penetration
  12751. PROFPEN0 = @TOKAPEN TAB1;
  12752. VPAT1 = VPAT1 + PROFPEN0 ;
  12753. FINSI;
  12754. FINSI;
  12755. VFP1 = FLUX TAB1.'MODELF' VPAT1 ;
  12756. SI (EXISTE TAB1 <PUISSANCE_EXTRAITE) ;
  12757. TAB1.LIS_FLUX = TAB1.<PUISSANCE_EXTRAITE/(MAXI(RESU VFP1));
  12758. FINSI ;
  12759. VFP1 = FLUX TAB1.'MODELF' VPAT1 ;
  12760. * ---- pourquoi ne prendre que la derniere valeur de TAB1.LIS_FLUX
  12761. TAB1.V_SOM1 = (EXTR TAB1.LIS_FLUX (DIME TAB1.LIS_FLUX)) * (MAXI (RESU VFP1));
  12762. IVERIF = 1 ;
  12763. FINSI ;
  12764. SI (IVERIF EGA 0) ;
  12765. ERRE ' FLUXX : VERIFIER LA VALEUR DE TAB1.DEPOT_FLUX';
  12766. FINSI ;
  12767. SINON ;
  12768. ERRE ' FLUXX : PRECISEZ LA VALEUR TAB1.DEPOT_FLUX';
  12769. FINSI ;
  12770. TAB1.V_VPAT1 = VPAT1;
  12771.  
  12772. ***********
  12773. * CONSTRUCTION DE VFPAT1 : FLUX INCIDENT
  12774. *
  12775. TAB1.'VFPAT1' = TABLE;
  12776. DIME1 = DIME TAB1.LIS_FLUX;
  12777. INT1 = 0;
  12778. REPETER BOUC1 DIME1;
  12779. INT1 = INT1 + 1;
  12780. TAB1.'VFPAT1'.INT1 = (VPAT1 * (EXTR TAB1.LIS_FLUX INT1));
  12781. FIN BOUC1;
  12782. * AJOUT DU SECOND FLUX SI BESOIN
  12783. SI BOOL1;
  12784. INT1 = 0;
  12785. REPETER BOUC2 DIME1;
  12786. INT1 = INT1 + 1;
  12787. TAB1.'VFPAT1'.INT1 = TAB1.'VFPAT1'.INT1 + (VPAT2 * (EXTR TAB1.LIS_FLUXP INT1));
  12788. FIN BOUC2;
  12789. FINSI;
  12790.  
  12791. ***********************************
  12792. * PRISE EN COMPTE DE LA PENETRATION
  12793. SI ((NEG TAB1.DEPOT_FLUX 'CANON') ET (EXISTE TAB1 PENETRATION));
  12794. @CALPENE TAB1;
  12795. FINSI;
  12796.  
  12797.  
  12798. *****************************************
  12799. * CALCUL DE LA PUISSANCE ET DU FLUX MOYEN
  12800.  
  12801. SI (TAB1.PERMANENT);
  12802. INT2 = 0;
  12803. SINON;
  12804. SI (TAB1.TRANSITOIRE);
  12805. INT2 = (DIME TAB1.LIS_FLUX) - 1;
  12806. SINON;
  12807. ERRE 'IL FAUT CHOISIR PERMANENT OU TRANSITOIRE';
  12808. FINSI;
  12809. FINSI;
  12810. SI ((EGA TAB1.DEPOT_FLUX 'CANON') OU BOOL1);
  12811. SI BOOL1;
  12812. TAB1.'LIS_FLUMOYEN' = TAB1.LIS_FLUXP * TAB1.V_FACFM1;
  12813. SINON;
  12814. TAB1.'LIS_FLUMOYEN' = TAB1.LIS_FLUX * TAB1.V_FACFM1;
  12815. FINSI;
  12816. TAB1.'LIS_PUI1' = TAB1.'LIS_FLUMOYEN' * TAB1.L_HEATED * TAB1.WE_HEATED_N;
  12817. FINSI;
  12818. SI (NON (EGA TAB1.DEPOT_FLUX 'CANON'));
  12819. TAB1.'LIS_FLUMOYEN' = TAB1.LIS_FLUX * TAB1.V_FACFM2;
  12820. SI (EGA TAB1.DEPOT_FLUX 'PLASMAFLUX_2D');
  12821. SI (EXISTE TAB1 CENTRE_PLASMA);
  12822. TAB1.'LIS_PUI1' = TAB1.'LIS_FLUMOYEN' * TAB1.B_HEATED * TAB1.WE_HEATED_R;
  12823. SINON;
  12824. TAB1.'LIS_PUI1' = TAB1.'LIS_FLUMOYEN' * TAB1.L_HEATED * TAB1.WE_HEATED_R;
  12825. FINSI;
  12826. SI (EXISTE TAB1 PENETRATION);
  12827. TAB1.'LIS_PUI1' = TAB1.LIS_PUIPENE * TAB1.L_HEATED;
  12828. FINSI;
  12829. SINON;
  12830. SI ((VALE DIME) EGA 3);
  12831. TAB1.'LIS_PUI1'= TAB1.'LIS_FLUMOYEN' * (MESU TAB1.LFLUX_EXTE);
  12832. SINON ;
  12833. SI ( EXISTE TAB1 B_HEATED) ;
  12834. TAB1.'LIS_PUI1'= TAB1.'LIS_FLUMOYEN' * (MESU TAB1.LFLUX_EXTE)* (TAB1.B_HEATED);
  12835. SINON ;
  12836. TAB1.'LIS_PUI1'= TAB1.'LIS_FLUMOYEN' * (MESU TAB1.LFLUX_EXTE)* (TAB1.L_HEATED);
  12837. FINSI ;
  12838. FINSI ;
  12839. FINSI;
  12840. FINSI;
  12841.  
  12842. *jsTAB1.'FLU1' = TABLE;
  12843. *jsTAB1.'PUI1' = TABLE;
  12844. *jsNB1 = (DIME TAB1.LIS_FLUX) - INT2;
  12845. *jsREPETER BOUC3 NB1;
  12846. *js INT2 = INT2 + 1;
  12847. *js TAB1.'PUI1'.INT2 = 0.;
  12848. *js SI ((EGA TAB1.DEPOT_FLUX 'CANON') OU BOOL1);
  12849. *js SI BOOL1;
  12850. *js FLU1 = (EXTR TAB1.LIS_FLUXP INT2) * TAB1.V_FACFM1;
  12851. *js SINON;
  12852. *js FLU1 = (EXTR TAB1.LIS_FLUX INT2) * TAB1.V_FACFM1;
  12853. *js FINSI;
  12854. *js TAB1.'FLU1'.INT2 = FLU1;
  12855. *js TAB1.'PUI1'.INT2 = FLU1 * TAB1.L_HEATED * TAB1.WE_HEATED_N;
  12856. *js FINSI;
  12857. *js SI (NON (EGA TAB1.DEPOT_FLUX 'CANON'));
  12858. *js FLU1 = (EXTR TAB1.LIS_FLUX INT2) * TAB1.V_FACFM2;
  12859. *js TAB1.'FLU1'.INT2 = FLU1;
  12860. *js SI (EGA TAB1.DEPOT_FLUX 'PLASMAFLUX_2D');
  12861. *js SI (EXISTE TAB1 CENTRE_PLASMA);
  12862. *js TAB1.'PUI1'.INT2 = TAB1.'PUI1'.INT2
  12863. *js + (FLU1 * TAB1.B_HEATED * TAB1.WE_HEATED_R);
  12864. *js SINON;
  12865. *js TAB1.'PUI1'.INT2 = TAB1.'PUI1'.INT2
  12866. *js + (FLU1 * TAB1.L_HEATED * TAB1.WE_HEATED_R);
  12867. *js FINSI;
  12868. *js SI (EXISTE TAB1 PENETRATION);
  12869. *js TAB1.'PUI1'.INT2 = TAB1.'PUI1'.INT2
  12870. *js + (TAB1.PUIPENE.INT2 * TAB1.L_HEATED);
  12871. *js FINSI;
  12872. *js SINON;
  12873. *js TAB1.'PUI1'.INT2 = FLU1 * (MESU TAB1.LFLUX_EXTE);
  12874. *js FINSI;
  12875. *js FINSI;
  12876. *jsFIN BOUC3;
  12877. SI (NIVEAU >EG 4) ;
  12878. MESS '--------------------------> exiting @FLUXX';
  12879. FINSI ;
  12880. MESS '>>>FLUXX>> FLU_MOYEN ET PUI1';
  12881. list TAB1.'LIS_FLUMOYEN';
  12882. list TAB1.'LIS_PUI1';
  12883. FINPROC;
  12884.  
  12885.  
  12886. **** @FLUX_3D
  12887. *--------------------------------------------------------------------
  12888. * Procedure @FLUX_3D
  12889. *--------------------------------------------------------------------
  12890. DEBPROC @FLUX_3D TAB1*TABLE;
  12891. MESS '---------------------------------> calling @FLUX_3D';
  12892. *
  12893. ****** ATTENTION --> Cette procedure ne tourne qu'en 3D
  12894.  
  12895. S_TOT1 = TAB1.M_ILLAGE_TOT ;
  12896. LPAT1 = TAB1.LFLUX_EXTE ;
  12897. COSDIR1 COSDIR2 COSDIR3 = @VNORM3D (EXTR TAB1.'MODELF' 'MAIL') LPAT1 TAB1.'NIVEAU';
  12898.  
  12899. SI ((EXISTE TAB1 VAL_ANGLEI1) ET (EXISTE TAB1 VAL_ANGLEI2));
  12900. SI (EXISTE TAB1 CENTRE_PLASMA);
  12901. ERREUR 'ON NE PEUT PAS AVOIR ANGLEI1 ET LE CENTRE DU PLASMA';
  12902. FINSI;
  12903. SINON;
  12904. ERR 'CAS NON PREVU POUR L INSTANT';
  12905. FINSI;
  12906.  
  12907. *
  12908. * CALCUL DES DISTANCES AU POINT DE TANGENCE
  12909. *******************************************
  12910. COSP1 = (COS TAB1.VAL_ANGLEI1) * (COS TAB1.VAL_ANGLEI2);
  12911. COSP2 = (COS TAB1.VAL_ANGLEI1) * (SIN TAB1.VAL_ANGLEI2);
  12912. COSP3 = SIN TAB1.VAL_ANGLEI1;
  12913. XPTG = COOR 1 TAB1.PT_TGPLASMA;
  12914. YPTG = COOR 2 TAB1.PT_TGPLASMA;
  12915. ZPTG = COOR 3 TAB1.PT_TGPLASMA;
  12916. XP1 = COOR 1 LPAT1;
  12917. YP1 = COOR 2 LPAT1;
  12918. ZP1 = COOR 3 LPAT1;
  12919. A1 = (COSP1*(XPTG - XP1)) + (COSP2*(YPTG - YP1)) + (COSP3*(ZPTG - ZP1));
  12920. B1 = (COSP1**2) + (COSP2**2) + (COSP3**2);
  12921. T1 = A1/B1;
  12922. XM1 = XPTG - (T1 * COSP1);
  12923. YM1 = YPTG - (T1 * COSP2);
  12924. ZM1 = ZPTG - (T1 * COSP3);
  12925.  
  12926. L1 = (((XM1 - XP1)**2) + ((YM1 - YP1)**2) + ((ZM1 - ZP1)**2))**.5;
  12927.  
  12928. *
  12929. * CALCUL DU PRODUIT SCALAIRE FLUX.NORMALE
  12930. *****************************************
  12931. VN1 = ( EXCO 'SCAL' COSDIR1 'UX' ) + ( EXCO 'SCAL' COSDIR2 'UY' ) + ( EXCO 'SCAL' COSDIR3 'UZ' ) ;
  12932. DFL1 = MANU CHPO LPAT1 3 'FX' COSP1 'FY' COSP2 'FZ' COSP3;
  12933. SIN1 = ABS (PSCA VN1 DFL1 (MOTS 'UX' 'UY' 'UZ') (MOTS 'FX' 'FY' 'FZ'));
  12934.  
  12935.  
  12936. VPAT1 = EXP (-1.*L1/TAB1.LAMDAQ) * SIN1;
  12937.  
  12938. TRAC QUAL (-1.E3 -1.E3 1.E3) VPAT1 LPAT1;
  12939. TRAC QUAL (1.E3 -1000. 1.E3) VPAT1 LPAT1;
  12940.  
  12941. *
  12942. * CALCUL DU FLUX MOYEN ET DE LA PUISSANCE
  12943. *****************************************
  12944. VFP1 = FLUX TAB1.'MODELF' VPAT1 ;
  12945. TAB1.V_SOM1 = (EXTR TAB1.LIS_FLUX (DIME TAB1.LIS_FLUX)) * (MAXI (RESU VFP1));
  12946. TAB1.V_FACFM2 = (MAXI (RESU VFP1)) / (MESU LPAT1) ;
  12947.  
  12948.  
  12949. MESS '---------------------------------> Sortie de @FLUX_3D';
  12950. FINPROC VPAT1;
  12951.  
  12952. **** @FRENET
  12953. *****************************************************************
  12954. * PROCEDURE FRENET : CALCUL DU REPERE DE FRENET LE LONG D'UNE LIGNE
  12955. *****************************************************************
  12956. DEBPROC @FRENET GEO*MAILLAGE MOT1/MOT OEIL1/POINT;
  12957. LOG1 = EXISTE MOT1;
  12958. GEO1 = CHAN SEG2 GEO ;
  12959. DIMGEO = VALEUR DIME ;
  12960. SI (DIMGEO > 2);
  12961. NEL = NBEL GEO1 ;
  12962. NP = NBNO GEO1 ;
  12963. IP = 1 ;
  12964. REPETER BOUC1 (NEL - 1) ;
  12965. IP = IP + 1 ;
  12966. * mess 'ip =' ip ;
  12967. EIP1 = GEO1 ELEM (IP - 1 ) ;
  12968. PI1 = EIP1 POIN INITIAL ;
  12969. EIP2 = GEO1 ELEM IP ;
  12970. PIP = EIP2 POIN INITIAL ;
  12971. PI2 = EIP2 POIN FINAL ;
  12972. LII = EIP1 ET EIP2 ;
  12973. V1 = MOIN PI1 PIP ;
  12974. V2 = MOIN PIP PI2 ;
  12975. V4 = V1 PVEC V2 ;
  12976. SI ((NORM V4) < ((NORM V1) * 1.E-5));
  12977. SI (IP < NEL);
  12978. INCR = IP;
  12979. REPETER BOUC2 ;
  12980. INCR = INCR + 1 ;
  12981. * MESS ' INCR = ' INCR;
  12982. ELE1 = GEO1 ELEM INCR ;
  12983. PT2 = ELE1 POIN FINAL ;
  12984. V22 = MOIN PIP PT2 ;
  12985. V42 = V1 PVEC V22 ;
  12986. SI ((NORM V42) > ((NORM V1) * 1.E-5)) ;
  12987. QUITTER BOUC2 ;
  12988. FINSI ;
  12989. SI (INCR EGA NEL) ;
  12990. V42 = V1 PVEC (1. 0. 0.) ;
  12991. SI ((NORM V42) > ((NORM V1) * 1.E-5)) ;
  12992. * MESS 'PERPENDICULAIRE A L AXE X';
  12993. QUITTER BOUC2 ;
  12994. SINON ;
  12995. V42 = V1 PVEC (0. -1. 0.) ;
  12996. * MESS 'PERPENDICULAIRE A L AXE Y';
  12997. QUITTER BOUC2 ;
  12998. FINSI ;
  12999. FINSI ;
  13000. FIN BOUC2 ;
  13001. V4 = V42 ;
  13002. SINON ;
  13003. * MESS ' DERNIER VECTEUR ';
  13004. V4 = BPI;
  13005. FINSI;
  13006. FINSI;
  13007. NV4 = NORM V4 ;
  13008. BPI = V4 * ( 1. / NV4 ) ;
  13009. CHBI = MANU CHPO PIP 3 'BX' (COOR 1 BPI) 'BY' (COOR 2 BPI) 'BZ' (COOR 3 BPI) NATURE DIFFUS;
  13010. V4 = BPI PVEC V1 ;
  13011. V5 = BPI PVEC V2 ;
  13012. V6 = V4 PLUS V5 ;
  13013. NPI = -1. * (V6/(NORM V6)) ;
  13014. CHNI = MANU CHPO PIP 3 'NX' (COOR 1 NPI) 'NY' (COOR 2 NPI) 'NZ' (COOR 3 NPI) NATURE DIFFUS;
  13015. TPI = NPI PVEC BPI ;
  13016. CHTI = MANU CHPO PIP 3 'TX' (COOR 1 TPI) 'TY' (COOR 2 TPI) 'TZ' (COOR 3 TPI) NATURE DIFFUS;
  13017. SI (EGA IP 2) ;
  13018. CHB = CHBI ;
  13019. CHN = CHNI ;
  13020. CHT = CHTI ;
  13021. SINON ;
  13022. CHB = CHB ET CHBI ;
  13023. CHN = CHN ET CHNI ;
  13024. CHT = CHT ET CHTI ;
  13025. FINSI ;
  13026. FIN BOUC1 ;
  13027. * MESS 'ELEMENT N0 1' ;
  13028. EI1 = GEO1 ELEM 1 ;
  13029. PI1 = EI1 POIN INITIAL ;
  13030. P2 = EI1 POIN FINAL ;
  13031. EL2 = GEO1 ELEM 2 ;
  13032. EL3 = GEO1 ELEM 3 ;
  13033. EL4 = GEO1 ELEM 4 ;
  13034. CHT2 = REDU CHT EL2 ;
  13035. CHT3 = REDU CHT EL3 ;
  13036. CHT4 = REDU CHT EL4 ;
  13037. CHN2 = REDU CHN EL2 ;
  13038. CHN3 = REDU CHN EL3 ;
  13039. CHN4 = REDU CHN EL4 ;
  13040. CHB2 = REDU CHB EL2 ;
  13041. CHB3 = REDU CHB EL3 ;
  13042. CHB4 = REDU CHB EL4 ;
  13043. DS2 R2 T2 ALPHA2 BETA2 = @COUTOR1 EL2 CHT2 CHN2 CHB2 ;
  13044. DS3 R3 T3 ALPHA3 BETA3 = @COUTOR1 EL3 CHT3 CHN3 CHB3 ;
  13045. DS4 R4 T4 ALPHA4 BETA4 = @COUTOR1 EL4 CHT4 CHN4 CHB4 ;
  13046. DS1 = NORM (MOIN PI1 P2) ;
  13047. RAP12 = (DS1+DS2)/2;
  13048. RAP23 = (DS2+DS3)/2;
  13049. RAP34 = (DS3+DS4)/2;
  13050. PR2 = (R3-R2)/RAP23;
  13051. PR3 = (R4-R3)/RAP34;
  13052. PT2 = (T3-T2)/RAP23;
  13053. PT3 = (T4-T3)/RAP34;
  13054. RAP = (DS1+(2*DS2)+DS3)/(DS2+(2*DS3)+DS4);
  13055. PR1 = PR2+((PR2-PR3)*RAP);
  13056. R1 = R2-(PR1*RAP12);
  13057. ALPHA1 = -1. * (DS1/R1)* (180. / PI);
  13058. SI (T2 > 1.E98);
  13059. BETA1 = 0. ;
  13060. FINSI ;
  13061. SI (T3 > 1.E98) ;
  13062. SI (T2 > 1.E98);
  13063. BETA1 = 0. ;
  13064. SINON ;
  13065. TT1 = (1./T2)*(1. + RAP) ;
  13066. T1 = 1./TT1 ;
  13067. BETA1 = (DS1/T1)*180/PI;
  13068. FINSI ;
  13069. FINSI ;
  13070. SI ((T2 < 1.E98) ET (T3 < 1.E98)) ;
  13071. PT1 = PT2+((PT2-PT3)*RAP);
  13072. T1 = T2-(PT1*RAP12);
  13073. BETA1 = (DS1/T1)*180./PI ;
  13074. FINSI ;
  13075. NXI2 = EXTR CHN NX P2 ;
  13076. NYI2 = EXTR CHN NY P2 ;
  13077. NZI2 = EXTR CHN NZ P2 ;
  13078. VN2 = NXI2 NYI2 NZI2 ;
  13079. TXI2 = EXTR CHT TX P2 ;
  13080. TYI2 = EXTR CHT TY P2 ;
  13081. TZI2 = EXTR CHT TZ P2 ;
  13082. VT2 = TXI2 TYI2 TZI2 ;
  13083. BXI2 = EXTR CHB BX P2 ;
  13084. BYI2 = EXTR CHB BY P2 ;
  13085. BZI2 = EXTR CHB BZ P2 ;
  13086. VB2 = BXI2 BYI2 BZI2 ;
  13087. VN = (VN2 * (COS BETA1)) PLUS (VB2 * (SIN BETA1)) ;
  13088. VB1 = (VN2 * (-1.*(SIN BETA1))) PLUS (VB2 * (COS BETA1)) ;
  13089. VT1 = (VT2 * (COS ALPHA1)) PLUS (VN * (SIN ALPHA1)) ;
  13090. VN1 = (VT2 * (-1.*(SIN ALPHA1))) PLUS (VN * (COS ALPHA1)) ;
  13091. CHTI = MANU CHPO PI1 3 'TX' (COOR 1 VT1) 'TY' (COOR 2 VT1) 'TZ' (COOR 3 VT1) NATURE DIFFUS;
  13092. CHT = CHT ET CHTI ;
  13093. CHNI = MANU CHPO PI1 3 'NX' (COOR 1 VN1) 'NY' (COOR 2 VN1) 'NZ' (COOR 3 VN1) NATURE DIFFUS;
  13094. CHN = CHN ET CHNI ;
  13095. CHBI = MANU CHPO PI1 3 'BX' (COOR 1 VB1) 'BY' (COOR 2 VB1) 'BZ' (COOR 3 VB1) NATURE DIFFUS;
  13096. CHB = CHB ET CHBI ;
  13097. * MESS 'ELEMENT N0 NEL' ;
  13098. EI1 = GEO1 ELEM NEL ;
  13099. PI1 = EI1 POIN FINAL ;
  13100. P2 = EI1 POIN INITIAL ;
  13101. EL2 = GEO1 ELEM (NEL-1) ;
  13102. EL3 = GEO1 ELEM (NEL-2) ;
  13103. EL4 = GEO1 ELEM (NEL-3) ;
  13104. CHT2 = REDU CHT EL2 ;
  13105. CHT3 = REDU CHT EL3 ;
  13106. CHT4 = REDU CHT EL4 ;
  13107. CHN2 = REDU CHN EL2 ;
  13108. CHN3 = REDU CHN EL3 ;
  13109. CHN4 = REDU CHN EL4 ;
  13110. CHB2 = REDU CHB EL2 ;
  13111. CHB3 = REDU CHB EL3 ;
  13112. CHB4 = REDU CHB EL4 ;
  13113. DS2 R2 T2 ALPHA2 BETA2 = @COUTOR1 EL2 CHT2 CHN2 CHB2 ;
  13114. DS3 R3 T3 ALPHA3 BETA3 = @COUTOR1 EL3 CHT3 CHN3 CHB3 ;
  13115. DS4 R4 T4 ALPHA4 BETA4 = @COUTOR1 EL4 CHT4 CHN4 CHB4 ;
  13116. DS1 = NORM (MOIN PI1 P2) ;
  13117. RAP12 = (DS1+DS2)/2;
  13118. RAP23 = (DS2+DS3)/2;
  13119. RAP34 = (DS3+DS4)/2;
  13120. PR2 = (R3-R2)/RAP23;
  13121. PR3 = (R4-R3)/RAP34;
  13122. PT2 = (T3-T2)/RAP23;
  13123. PT3 = (T4-T3)/RAP34;
  13124. RAP = (DS1+(2*DS2)+DS3)/(DS2+(2*DS3)+DS4);
  13125. PR1 = PR2+((PR2-PR3)*RAP);
  13126. R1 = R2-(PR1*RAP12);
  13127. ALPHA1 = (DS1/R1)*180./PI;
  13128. SI (T2 > 1.E98);
  13129. BETA1 = 0. ;
  13130. FINSI ;
  13131. SI (T3 > 1.E98) ;
  13132. SI (T2 > 1.E98);
  13133. BETA1 = 0. ;
  13134. SINON ;
  13135. TT1 = (1./T2)*(1. + RAP) ;
  13136. T1 = 1./TT1 ;
  13137. BETA1 = -1.*(DS1/T1)*180/PI;
  13138. FINSI ;
  13139. FINSI ;
  13140. SI ((T2 < 1.E98) ET (T3 < 1.E98)) ;
  13141. PT1 = PT2+((PT2-PT3)*RAP);
  13142. T1 = T2-(PT1*RAP12);
  13143. BETA1 = -1.*(DS1/T1)*180/PI ;
  13144. FINSI ;
  13145. NXI2 = EXTR CHN NX P2 ;
  13146. NYI2 = EXTR CHN NY P2 ;
  13147. NZI2 = EXTR CHN NZ P2 ;
  13148. VN2 = NXI2 NYI2 NZI2 ;
  13149. TXI2 = EXTR CHT TX P2 ;
  13150. TYI2 = EXTR CHT TY P2 ;
  13151. TZI2 = EXTR CHT TZ P2 ;
  13152. VT2 = TXI2 TYI2 TZI2 ;
  13153. BXI2 = EXTR CHB BX P2 ;
  13154. BYI2 = EXTR CHB BY P2 ;
  13155. BZI2 = EXTR CHB BZ P2 ;
  13156. VB2 = BXI2 BYI2 BZI2 ;
  13157. VT1 = ((VT2 * (COS ALPHA1)) PLUS (VN2 * (SIN ALPHA1))) ;
  13158. VN = (VT2 * (-1. * (SIN ALPHA1))) PLUS (VN2 * (COS ALPHA1)) ;
  13159. VB = VB2 ;
  13160. VN1 = (VN * (COS BETA1)) PLUS (VB * (SIN BETA1)) ;
  13161. VB1 = (VN * (-1. * (SIN BETA1))) PLUS (VB * (COS BETA1)) ;
  13162. CHTI = MANU CHPO PI1 3 'TX' (COOR 1 VT1) 'TY' (COOR 2 VT1) 'TZ' (COOR 3 VT1) NATURE DIFFUS;
  13163. CHT = CHT ET CHTI ;
  13164. CHNI = MANU CHPO PI1 3 'NX' (COOR 1 VN1) 'NY' (COOR 2 VN1) 'NZ' (COOR 3 VN1) NATURE DIFFUS;
  13165. CHN = CHN ET CHNI ;
  13166. CHBI = MANU CHPO PI1 3 'BX' (COOR 1 VB1) 'BY' (COOR 2 VB1) 'BZ' (COOR 3 VB1) NATURE DIFFUS;
  13167. CHB = CHB ET CHBI ;
  13168. COX COY COZ = COOR GEO ;
  13169. XMAX = MAXI COX ;
  13170. YMAX = MAXI COY ;
  13171. ZMAX = MAXI COZ ;
  13172. XMIN = MINI COX ;
  13173. YMIN = MINI COY ;
  13174. ZMIN = MINI COZ ;
  13175. DL = (((XMAX - XMIN)**2) + ((YMAX -YMIN)**2) + ((ZMAX -ZMIN)**2))**0.5 ;
  13176. AMP = DL/10. ;
  13177. VT = VECT CHT AMP TX TY TZ ROUGE ;
  13178. VN = VECT CHN AMP NX NY NZ VERT ;
  13179. VB = VECT CHB AMP BX BY BZ JAUNE ;
  13180. SI (LOG1 EGA VRAI);
  13181. TITRE 'REPERE DE FRENET DE LA LIGNE' ;
  13182. TRAC OEIL1 QUAL (VT ET VN ET VB) GEO1 ;
  13183. FINSI;
  13184. SINON ;
  13185. NEL = NBEL GEO1;
  13186. NP = NBNO GEO1;
  13187. O = 0. 0.;
  13188. IP = 1;
  13189. REPETER BOUC2 (NEL - 1);
  13190. IP =IP+1;
  13191. * MESS ' IP = ' IP;
  13192. EIP1 = GEO1 ELEM (IP-1);
  13193. PI1 = EIP1 POIN INITIAL ;
  13194. EIP2 = GEO1 ELEM IP ;
  13195. PIP = EIP2 POIN INITIAL ;
  13196. PI2 = EIP2 POIN FINAL ;
  13197. V1 = MOIN PIP PI1;
  13198. V2 = MOIN PI2 PIP;
  13199. V3 = V1 TOUR 90. O;
  13200. V4 = V2 TOUR 90. O;
  13201. V5 = V3 PLUS V4;
  13202. NPI = V5 / (NORM V5);
  13203. TPI = NPI TOUR (-1*90.) O;
  13204. CHNI = MANU CHPO PIP 2 'NX' (COOR 1 NPI) 'NY' (COOR 2 NPI) NATURE DIFFUS;
  13205. CHTI = MANU CHPO PIP 2 'TX' (COOR 1 TPI) 'TY' (COOR 2 TPI) NATURE DIFFUS;
  13206. SI (EGA IP 2) ;
  13207. CHN = CHNI ;
  13208. CHT = CHTI ;
  13209. SINON ;
  13210. CHN = CHN ET CHNI ;
  13211. CHT = CHT ET CHTI ;
  13212. FINSI;
  13213. CHB = MANU CHPO GEO1 2 'BX' 0. 'BY' 0. ;
  13214. FIN BOUC2;
  13215.  
  13216. * MESS 'ELEMENT N0 1' ;
  13217. EI1 = GEO1 ELEM 1 ;
  13218. PI1 = EI1 POIN INITIAL ;
  13219. P2 = EI1 POIN FINAL ;
  13220. EL2 = GEO1 ELEM 2 ;
  13221. EL3 = GEO1 ELEM 3 ;
  13222. EL4 = GEO1 ELEM 4 ;
  13223. CHT2 = REDU CHT EL2 ;
  13224. CHT3 = REDU CHT EL3 ;
  13225. CHT4 = REDU CHT EL4 ;
  13226. CHN2 = REDU CHN EL2 ;
  13227. CHN3 = REDU CHN EL3 ;
  13228. CHN4 = REDU CHN EL4 ;
  13229. CHB2 = REDU CHB EL2 ;
  13230. CHB3 = REDU CHB EL3 ;
  13231. CHB4 = REDU CHB EL4 ;
  13232. DS2 R2 T2 ALPHA2 BETA2 = @COUTOR1 EL2 CHT2 CHN2 CHB2 ;
  13233. DS3 R3 T3 ALPHA3 BETA3 = @COUTOR1 EL3 CHT3 CHN3 CHB3 ;
  13234. DS4 R4 T4 ALPHA4 BETA4 = @COUTOR1 EL4 CHT4 CHN4 CHB4 ;
  13235. DS1 = NORM (MOIN PI1 P2) ;
  13236. RAP12 = (DS1+DS2)/2;
  13237. RAP23 = (DS2+DS3)/2;
  13238. RAP34 = (DS3+DS4)/2;
  13239. PR2 = (R3-R2)/RAP23;
  13240. PR3 = (R4-R3)/RAP34;
  13241. RAP = (DS1+(2*DS2)+DS3)/(DS2+(2*DS3)+DS4);
  13242. PR1 = PR2+((PR2-PR3)*RAP);
  13243. R1 = R2-(PR1*RAP12);
  13244. ALPHA1 = -1. * (DS1/R1)* (180. / PI);
  13245. NXI2 = EXTR CHN NX P2 ;
  13246. NYI2 = EXTR CHN NY P2 ;
  13247. VN2 = NXI2 NYI2 ;
  13248. TXI2 = EXTR CHT TX P2 ;
  13249. TYI2 = EXTR CHT TY P2 ;
  13250. VT2 = TXI2 TYI2 ;
  13251. BXI2 = EXTR CHB BX P2 ;
  13252. BYI2 = EXTR CHB BY P2 ;
  13253. VB2 = BXI2 BYI2 ;
  13254. VT1 = (VT2 * (COS ALPHA1)) PLUS (VN2 * (SIN ALPHA1)) ;
  13255. VN1 = (VT2 * (-1. * (SIN ALPHA1))) PLUS (VN2 * (COS ALPHA1)) ;
  13256. VB = VB2 ;
  13257. CHTI = MANU CHPO PI1 2 'TX' (COOR 1 VT1) 'TY' (COOR 2 VT1) NATURE DIFFUS;
  13258. CHT = CHT ET CHTI ;
  13259. CHNI = MANU CHPO PI1 2 'NX' (COOR 1 VN1) 'NY' (COOR 2 VN1) NATURE DIFFUS;
  13260. CHN = CHN ET CHNI ;
  13261.  
  13262. * MESS 'ELEMENT N0 NEL' ;
  13263. EI1 = GEO1 ELEM NEL ;
  13264. PI1 = EI1 POIN FINAL ;
  13265. P2 = EI1 POIN INITIAL ;
  13266.  
  13267. EL2 = GEO1 ELEM (NEL-1) ;
  13268. EL3 = GEO1 ELEM (NEL-2) ;
  13269. EL4 = GEO1 ELEM (NEL-3) ;
  13270. CHT2 = REDU CHT EL2 ;
  13271. CHT3 = REDU CHT EL3 ;
  13272. CHT4 = REDU CHT EL4 ;
  13273. CHN2 = REDU CHN EL2 ;
  13274. CHN3 = REDU CHN EL3 ;
  13275. CHN4 = REDU CHN EL4 ;
  13276. CHB2 = REDU CHB EL2 ;
  13277. CHB3 = REDU CHB EL3 ;
  13278. CHB4 = REDU CHB EL4 ;
  13279. DS2 R2 T2 ALPHA2 BETA2 = @COUTOR1 EL2 CHT2 CHN2 CHB2 ;
  13280. DS3 R3 T3 ALPHA3 BETA3 = @COUTOR1 EL3 CHT3 CHN3 CHB3 ;
  13281. DS4 R4 T4 ALPHA4 BETA4 = @COUTOR1 EL4 CHT4 CHN4 CHB4 ;
  13282. DS1 = NORM (MOIN PI1 P2) ;
  13283. RAP12 = (DS1+DS2)/2;
  13284. RAP23 = (DS2+DS3)/2;
  13285. RAP34 = (DS3+DS4)/2;
  13286. PR2 = (R3-R2)/RAP23;
  13287. PR3 = (R4-R3)/RAP34;
  13288. RAP = (DS1+(2*DS2)+DS3)/(DS2+(2*DS3)+DS4);
  13289. PR1 = PR2+((PR2-PR3)*RAP);
  13290. R1 = R2-(PR1*RAP12);
  13291. ALPHA1 = (DS1/R1)*180./PI;
  13292. NXI2 = EXTR CHN NX P2 ;
  13293. NYI2 = EXTR CHN NY P2 ;
  13294. VN2 = NXI2 NYI2 ;
  13295. TXI2 = EXTR CHT TX P2 ;
  13296. TYI2 = EXTR CHT TY P2 ;
  13297. VT2 = TXI2 TYI2 ;
  13298. VT1 = ((VT2 * (COS ALPHA1)) PLUS (VN2 * (SIN ALPHA1))) ;
  13299. VN1 = (VT2 * (-1. * (SIN ALPHA1))) PLUS (VN2 * (COS ALPHA1)) ;
  13300. CHTI = MANU CHPO PI1 2 'TX' (COOR 1 VT1) 'TY' (COOR 2 VT1) NATURE DIFFUS;
  13301. CHT = CHT ET CHTI ;
  13302. CHNI = MANU CHPO PI1 2 'NX' (COOR 1 VN1) 'NY' (COOR 2 VN1) NATURE DIFFUS;
  13303. CHN = CHN ET CHNI ;
  13304.  
  13305. COX COY = COOR GEO ;
  13306. XMAX = MAXI COX ;
  13307. YMAX = MAXI COY ;
  13308. XMIN = MINI COX ;
  13309. YMIN = MINI COY ;
  13310. DL = (((XMAX - XMIN)**2) + ((YMAX -YMIN)**2))**0.5 ;
  13311. AMP = DL/10. ;
  13312. VT = VECT CHT AMP TX TY ROUGE ;
  13313. VN = VECT CHN AMP NX NY VERT ;
  13314. SI (LOG1 EGA VRAI);
  13315. TITRE 'REPERE DE FRENET DE LA LIGNE' ;
  13316. TRAC QUAL (VN ET VT) GEO1;
  13317. FINSI;
  13318. FINSI ;
  13319. FINPROC CHT CHN CHB ;
  13320. **** @FRENETT
  13321. 'DEBPROC' @FRENETT LIGN_1*MAILLAGE ;
  13322. MESS '----------------------> entree dans @FRENETT ';
  13323. V1 = VALEUR DIME ;
  13324. SI( V1 EGA 2 ) ;
  13325. * CHT CHN CHB = @FRENET LIGN_1 'TRACE' ;
  13326. CHT CHN CHB = @FRENET LIGN_1 ;
  13327. CHPP = CHT ET CHN ;
  13328. SINON ;
  13329. * CHT CHN CHB = @FRENET LIGN_1 'TRACE' (0. 0. 1000.);
  13330. CHT CHN CHB = @FRENET LIGN_1 ;
  13331. CHPP = CHT ET CHN ET CHB ;
  13332. FINSI ;
  13333. MESS '----------------------> sortie de @FRENETT ';
  13334. 'FINPROC' CHPP;
  13335. **** FROTTER
  13336. *---------------------------------------------------------------------
  13337. * PROCEDURE FROTTER VERSION DU 15/11/87
  13338. * MODIFICATION RECUE LE 22/09/1992
  13339. *---------------------------------------------------------------------
  13340. * CETTE PROCEDURE SERT A CALCULER LE CONTACT AVEC FROTTEMENT
  13341. *
  13342. * SYNTAXE :
  13343. * -------
  13344. *
  13345. *
  13346. * SOL RE = FROTTER RIG FOR BLOCAG COEF ;
  13347. *
  13348. * RIG : LA RIGIDITE AVEC SES BLOCAGES AUTRES QUE UNILATERAUX
  13349. * ET DE FROTTEMENT
  13350. * FOR : LE VECTEUR SECOND MEMBRE
  13351. * BLOCAG : LES BLOCAGES UNILATERAUX ET DE FROTTEMENT
  13352. * COEF : LES COEFFICIENTS DE FROTTEMENT
  13353. *
  13354. * EN SORTIE : DE : LA SOLUTION
  13355. * RE : LES REACTIONS D'APPUIS
  13356. * RIAD
  13357. *
  13358. *---------------------------------------------------------------------
  13359. *
  13360. DEBPROC FROTTER ZR*RIGIDITE FFF*CHPOINT BBN*RIGIDITE BBT*RIGIDITE ZCOEF*CHPOINT ZEZE*MAILLAGE IPAPA*ENTIER;
  13361. *
  13362. *----------------------------------------------------------------------
  13363. *
  13364. *--------------------
  13365. * INITIALISATIONS
  13366. *--------------------
  13367. *
  13368. MAXIT = 10 ;
  13369. *----------------------- MILL 16 / 4 /92
  13370. *ZPREC1 = 1.E-8;
  13371. *ZPREC2 = 1.E-4 ;
  13372. ZPREC1 = 1.E-10;
  13373. ZPREC2 = 1.E-8 ;
  13374. *-----------------------
  13375. GEOT= EXTRAI BBT MAIL MULT ;
  13376. BBB = BBN ET BBT ;
  13377. *MESS ' LES NOEUDS ASSOCIES A BBN ' ;NOBBN =EXTRAI BBN MAIL MULT ;
  13378. *LIST NOBBN;
  13379. *MESS ' LES NOEUDS ASSOCIES A BBT ' ;NOBBT =EXTRAI BBT MAIL MULT ;
  13380. *LIST NOBBT;
  13381. SSDIM = VALEUR DIME ;
  13382. SI ( EGA SSDIM 3 ) ;
  13383. OEIL = -1000 -1500 20000 ;
  13384. FINSI ;
  13385. *
  13386. *------------------------------
  13387. * CALCUL DU SUPER ELEMENT
  13388. *------------------------------
  13389. *
  13390. SUP = SUPER RIGI ZR BBB ;
  13391. STAT = VRAI ;
  13392. RISUP = EXTRAI SUP RIGI;
  13393. FFF0= DEPIMP BBB 0.; FA = FFF ET FFF0;
  13394. *MESS ' VECTEUR FFF EN ENTREE DE FROTTER ' ;
  13395. *LIST FFF ;
  13396. F = SUPER CHAR SUP FA ;
  13397. *MESS ' VECTEUR F SORTI DE SUPER ' ; LIST F ;
  13398.  
  13399. DETR FFF0 GEOM ;
  13400. *
  13401. *-----------------------
  13402. * INITIALISATIONS
  13403. *-----------------------
  13404. *
  13405. ITER = 0 ;
  13406. NCONV = VRAI ;
  13407. FROT = MANU CHPO GEOT 2 FX 0. FY 0. ;
  13408. DE = MANU CHPO GEOT 2 UX 0. UY 0. ;
  13409. DEPTOT = FA EXCO FLX FLX ;
  13410. *MESS ' DEPTOT ' ; LIST DEPTOT ;
  13411. FDEPTO = F ET DEPTOT ;
  13412. *MESS ' VOICI FDEPTO ' ; LIST FDEPTO ;
  13413. RITOU = RISUP ET BBB ;
  13414. * INITIALISER LISEA A UNE VALEUR IMPOSSIBLE
  13415. LISEA = LECT -1;
  13416. FDEPTOT=F ;
  13417. *MESS ' ON MOYENNE LES FORCES DE FROTTEMENT ' ;
  13418. *
  13419. *---------------
  13420. * ITERATIONS
  13421. *---------------
  13422. *
  13423. SAUTER 2 LIGNE ;
  13424. REPETER BOUCL1 MAXIT ;
  13425. ITER = ITER + 1 ;
  13426. MESS ' PROCEDURE FROTTER - ITERATION NUMERO ' ITER ;
  13427. FPRES = FROT ;
  13428. DRES = DE ;
  13429. *MESS ' ON ATTAQUE LA RESOLUTION ' ;
  13430. *MESS ' VOICI LES FORCES ' ; LIST FDEPTOT ;
  13431. *MESS ' VOICI LES RAIDEURS ' ; LIST RITOU ;
  13432.  
  13433. DE=RESOU NOID NOUNIL RITOU FDEPTOT;
  13434.  
  13435. *MESS ' VOICI LA SOLUTION SORTIE DE RESOU ' ; LIST DE ;
  13436. *
  13437. * ICI L'ACCELERATION DE CONVERGENCE
  13438. * ELLE SEMBLE UN PEU FOIREUSE PAR MOMENTS
  13439. *
  13440. SI ('MULT' ITER 5 ) ;
  13441. * SI ('MULT' ITER 30000) ;
  13442. SI NCONVT ;
  13443. SI LENEW;
  13444. ZDP1= 'ACTI' 'GEOM' ZDEPN2 ZDEPN1 DE;
  13445. 'DETR' DE ;
  13446. DE = ZDP1 ;
  13447. FINSI ;
  13448. FINSI ;
  13449. FINSI ;
  13450. 'SI' (ITER > 1 ) ;
  13451. 'SI' ( ITER > 2 ) ; 'DETR' ZDEPN2 'GEOM' ; 'FINSI';
  13452. ZDEPN2 = ZDEPN1 ;
  13453. 'FINSI' ;
  13454. ZDEPN1 = 'COPIER' DE 'GEOM' ;
  13455.  
  13456. *MESS ' LES DEPLACEMENTS ' ; LIST DE ;
  13457. *MESS ' FORCES NORMALES ' ; LIST ( REDU DE NOBBN);
  13458. *MESS ' FORCES TANGENTES' ; LIST ( REDU DE NOBBT);
  13459. *
  13460. * PETIT DESSIN
  13461. *
  13462. VV =VECTEUR FDEPTOT 0.1 FX FY VERT;
  13463. *DEF0=DEFOR ZEZE DE 0 BLEU;
  13464. *DEF1=DEFOR ZEZE DE 10 VV ROSE;
  13465. *TRAC ( DEF0 ET DEF1 ) ;
  13466. * OPTI DONN 5 ;
  13467. *MESS ' ON APPELLE GLISSER ' ;
  13468. *MESS ' ON IMPRIME BBB ' ; LIST BBB ;
  13469. *OPTI IMPI 528 ;
  13470. *OPTI IMPI 530 ;
  13471. SI ( >EG IPAPA 7);
  13472. *OPTI IMPI 530 ;
  13473. * OPTI IMPI 528 ;
  13474. FINSI;
  13475. *BLOTO RIAD LISEN FROTB = BBB GLISSER DE DEPTOT FPRES ZCOEF ;
  13476. BLOTO RIAD LISEN FROT = BBB GLISSER DE DEPTOT FPRES ZCOEF ;
  13477. OPTI IMPI 0 ;
  13478. *MESS ' ON IMPRIME BLOTO ' ; LIST BLOTO ;
  13479. *FROT = ( FROTB + FPRES ) / 2. ;
  13480. *MESS ' LES FORCES DE FROTTEMENT FROT ' ; LIST FROT ;
  13481. SI ( EGA SSDIM 3 ) ;
  13482.  
  13483. *$$ON ESSAYE DE TRACER CES FORCES
  13484. *VV1 =VECTEUR FROTB 0.1 FX FY FZ VERT;
  13485. VV1 =VECTEUR FROT 0.1 FX FY FZ VERT;
  13486. *VV2 =VECTEUR FROT 0.1 FX FY FZ ROUG;
  13487. *VV3 =VECTEUR FPRES 0.1 FX FY FZ JAUN;
  13488. *DEF10=DEFOR ZEZE DE 0 VV1 BLEU ;
  13489. *DEF1=DEFOR ZEZE DE 0 VV1 BLEU ;
  13490. *DEF2=DEFOR ZEZE DE 0 VV2 TURQ ;
  13491. *DEF3=DEFOR ZEZE DE 0 VV3 ROSE ;
  13492. *TRAC OEIL ( DEF1 ET DEF2 ET DEF3 ) ;
  13493. *TRAC OEIL DEF1 ;
  13494. FINSI ;
  13495.  
  13496. SI ( EGA SSDIM 2 ) ;
  13497.  
  13498. VV1 =VECTEUR FROT 1 FX FY VERT;
  13499. *DEF10=DEFOR ZEZE DE 0 BLEU ;
  13500. *DEF1=DEFOR ZEZE DE VV1 TURQ ;
  13501. *DEF2=DEFOR ZEZE DE 0 VV2 TURQ ;
  13502. *DEF3=DEFOR ZEZE DE 0 VV3 ROSE ;
  13503. *TRAC OEIL ( DEF1 ET DEF2 ET DEF3 ) ;
  13504. *TRAC ( DEF1 ET DEF10) ;
  13505. FINSI ;
  13506. OPTI IMPI 0 ;
  13507. *-----------------------------
  13508. * TESTS DE CONVERGENCE
  13509. *-----------------------------
  13510. * D'ABORD SUR LES CONTACTS
  13511. *-----------------------------
  13512. NCONVT = FAUX ;
  13513. SI (LISEN EGA LISEA) ;
  13514. MESS ' ON A CONVERGE LES CONTACTS ' ;
  13515. NCONVT = VRAI ;
  13516. FINSI;
  13517. *-------------------------------------------------------------
  13518. * ENSUITE SUR LES FORCES DE FROTTEMENT ET LES DEPLACEMENTS
  13519. *-------------------------------------------------------------
  13520. SI NCONVT;
  13521. LENEW=FAUX;
  13522. *
  13523. * TEST SUR LES FORCES DE FROTTEMENT
  13524. *
  13525. FDIFF = FROT - FPRES ;
  13526. *MESS ' La difference sur les forces de frottement';
  13527. *list fdiff;
  13528. DENOM= XTX FROT ;
  13529. SI ( EGA DENOM 0. ) ;
  13530. KRIT1 = ABS ( ( XTX FDIFF ) );
  13531. SINON ;
  13532. KRIT1 = ABS ( ( XTX FDIFF ) / DENOM ) ;
  13533. FINSI ;
  13534. MESS ' ITERATION ' ITER ' CRITERE 1 ' KRIT1 ;
  13535. SI ( KRIT1 < ZPREC1 ) ;
  13536. LENEW=VRAI;
  13537. *
  13538. * TEST SUR LES DEPLACEMENTS
  13539. *
  13540. FDIFF = DE - DRES;
  13541. FDIFF = ENLEVER FDIFF 'LX' ;
  13542. * MESS ' La difference sur les deplacements';
  13543. *list fdiff;
  13544. DENOM= XTX DE ;
  13545. SI ( EGA DENOM 0. ) ;
  13546. KRIT2= ABS ( ( XTX FDIFF ) );
  13547. SINON ;
  13548. KRIT2 = ABS ( ( XTX FDIFF ) / DENOM ) ;
  13549. FINSI ;
  13550. MESS ' ITERATION ' ITER ' CRITERE 2 ' KRIT2 ;
  13551. *
  13552. SI ( KRIT2 < ZPREC2) ;
  13553. NCONV = FAUX ;
  13554. DETR LISEN ;
  13555. GFO=EXTRAI BLOTO MAIL;DETR GFO TOUT;
  13556. DETR BLOTO ELEM ;
  13557. QUITTER BOUCL1 ;
  13558. FINSI ;
  13559. FINSI ;
  13560. FINSI ;
  13561. *
  13562. DETRUIRE RITOU; DETRUIRE LISEA;
  13563. SI (ITER NEG 1);GFO=EXTRAI BLOTT MAIL;DETR GFO TOUT;
  13564. DETR BLOTT ELEM ; FINSI ;
  13565. *---------------------- MILL 16/4/92
  13566. RITOU = RISUP ET BLOTO ;
  13567. * RITOU = RISUP ET BLOTO ET RIAD ;
  13568. *----------------------
  13569. BLOTT= BLOTO;
  13570. LISEA=LISEN;
  13571. *---------------------- MILL 16/4/92
  13572. *MESS ' VOICI FROT ' ; LIST FROT ;
  13573. FDEPTOT=FDEPTO ET FROT ;
  13574. *----------------------
  13575. *
  13576. * ON SUPPRIME LA GESTION DES JEUX SUR LES NOEUDS DES BLOCAGES
  13577. * DE FROTTEMENT
  13578. *---------------------- MILL 16/4/92
  13579. * FDEPTOT= FDEPTO - ( REDU FDEPTO GEOT ) ;
  13580. *----------------------
  13581. * ON REMET LA GESTION DES JEUX SUR LES NOEUDS DES BLOCAGES
  13582. * DE FROTTEMENT MAIS EN PLUS SUBTIL
  13583. * DU COUP CA MARCHE POUR LES INCREMENTS DE FORCE NULS,
  13584. * MAIS CA NE MARCHERA PAS EN CAS DE DEPLACEMENT IMPOSE
  13585. * ASSOCIE A UNE CONDITION DE BLOCAGE AVEC FROTTEMENT
  13586. *
  13587. *---------------------- MILL 18/9/92
  13588. FDEPTOT= FDEPTOT - ( REDU DEPTOT GEOT ) ;
  13589. *----------------------
  13590. FIN BOUCL1;
  13591. *
  13592. * ON FAIT UN PEU DE MENAGE
  13593. *
  13594. MENAGE;
  13595. *
  13596. SI NCONV ;
  13597. MESS ' IL N Y A PAS DE SOLUTION AU SYSTEME ';
  13598. RITOU = RISUP ET BBB ;
  13599. LISEA = LECT 0;
  13600. SINON;
  13601. *
  13602. MESS ' CONVERGENCE EN' ITER 'ITERATIONS DANS LA RESOLUTION DES CONTACTS AVES FROTTEMENT ' ;
  13603. *
  13604. *-----------------------------------
  13605. * CALCUL SUR TOUTE LA STRUCTURE
  13606. *-----------------------------------
  13607. *
  13608. RIINT = EXTRAI SUP RIGT ;
  13609. DP = SUPER DEPL SUP DE;
  13610. DPFFF=DP ET FFF ET FROT ;
  13611. MESS ' RETOUR DANS TOUTE LA STRUCTURE ' ;
  13612. DE1 = RESOU NOUNIL NOID RIINT DPFFF ; DE3 =DE1 EXCO LX NOID LX;
  13613. RE1= DE EXCO LX NOID LX ; DE4 = DE3 * -1;
  13614. DE5 = QULX DE1 ZR ;
  13615. DE2=DE1 ET RE1 ET DE4 ET DE5 ; DETR DE3; DETR DE4 GEOM;
  13616. DETRUIRE DE1; DETRUIRE RE1 GEOM; DETRUIRE DPFFF GEOM;
  13617. DETRUIRE DP GEOM ; DETR DE5 GEOM;
  13618. *
  13619. * LES REACTIONS
  13620. *
  13621. RE2 = ( REAC RITOU DE ) ET FROT ;
  13622. *
  13623. FINSI ;
  13624. *
  13625. DETRUIRE F GEOM;DETRUIRE DEPTOT GEOM;DETR DE;
  13626. SI ( NEG ITER 1 ) ;
  13627. DETRUIRE FDEPTOT GEOM ;
  13628. FINSI ;
  13629. DETR FA GEOM;
  13630. *
  13631. FINPRO DE2 RE2 FROT RIAD;
  13632.  
  13633.  
  13634.  
  13635.  
  13636. **** HELICE
  13637. ******************************************************
  13638. * PROCEDURE HELICE DE MAILLAGE EN HELICE
  13639. ******************************************************
  13640. DEBPROC HELICE P1/POINT GEO1/MAILLAGE TYP1*MOT P0*POINT V0*POINT PAS*FLOTTANT ALPHA*FLOTTANT NP*ENTIER ;
  13641. DALPHA = ALPHA / NP ;
  13642. DVT = (V0 / (NORM V0)) * (DALPHA / 360.) * PAS ;
  13643. *------------------------------------------------
  13644. * CAS OU LA BASE EST UN POINT
  13645. *------------------------------------------------
  13646. SI (EGA TYP1 'POIN') ;
  13647. PF1 = P1 ;
  13648. IB = 0 ;
  13649. REPETER BOUC1 NP ;
  13650. IB = IB + 1 ;
  13651. PI1 = PF1 ;
  13652. PF1 = (PI1 PLUS DVT) TOUR DALPHA P0 (P0 PLUS V0) ;
  13653. LIG1 = DROIT 1 PI1 PF1 ;
  13654. SI (EGA IB 1) ;
  13655. GEO3 = LIG1 ;
  13656. SINON ;
  13657. GEO3 = GEO3 ET LIG1 ;
  13658. FINSI ;
  13659. FIN BOUC1 ;
  13660. GEO2 = PF1 ;
  13661. FINSI ;
  13662. *------------------------------------------------
  13663. * CAS OU LA BASE EST UNE LIGNE
  13664. *------------------------------------------------
  13665. SI (EGA TYP1 'LIGN') ;
  13666. LIGF1 = GEO1 ;
  13667. IB = 0 ;
  13668. REPETER BOUC2 NP ;
  13669. IB = IB + 1 ;
  13670. LIGI1 = LIGF1 ;
  13671. LIGF1 = (LIGI1 PLUS DVT) TOUR DALPHA P0 (P0 PLUS V0) ;
  13672. * S1 = DALL1 1 LIGI1 LIGF1 ;
  13673. S1 = LIGI1 REGLER 1 LIGF1 ;
  13674. SI (EGA IB 1) ;
  13675. GEO3 = S1 ;
  13676. SINON ;
  13677. GEO3 = GEO3 ET S1 ;
  13678. FINSI ;
  13679. FIN BOUC2 ;
  13680. GEO2 = LIGF1 ;
  13681. FINSI ;
  13682. *------------------------------------------------
  13683. * CAS OU LA BASE EST UNE SURFACE
  13684. *------------------------------------------------
  13685. SI (EGA TYP1 'SURF') ;
  13686. SUF1 = GEO1 ;
  13687. IB = 0 ;
  13688. REPETER BOUC3 NP ;
  13689. IB = IB + 1 ;
  13690. SUI1 = SUF1 ;
  13691. SUF1 = (SUI1 PLUS DVT) TOUR DALPHA P0 (P0 PLUS V0) ;
  13692. V1 = SUI1 VOLU 1 SUF1 ;
  13693. SI (EGA IB 1) ;
  13694. GEO3 = V1 ;
  13695. SINON ;
  13696. GEO3 = GEO3 ET V1 ;
  13697. FINSI ;
  13698. FIN BOUC3 ;
  13699. GEO2 = SUF1 ;
  13700. FINSI ;
  13701. FINPROC GEO2 GEO3;
  13702. ****************************************************************
  13703. **** @IMPR
  13704. DEBPROC @IMPR PHRASE/TEXT NREEL/FLOTTANT NENTIER/ENTIER;
  13705. OPTI ECHO 0 ;
  13706. OPTI IMPR 26 ;
  13707. SI (EXISTE PHRASE);
  13708. MESS PHRASE;
  13709. FINSI ;
  13710. SI (EXISTE NREEL );
  13711. MESS NREEL ;
  13712. FINSI ;
  13713. SI (EXISTE NENTIER );
  13714. MESS NENTIER;
  13715. FINSI ;
  13716. OPTI IMPR 6 ;
  13717. OPTI ECHO 1 ;
  13718. FINPROC ;
  13719. **** @INCI
  13720. DEBPROC @INCI TAB1*TABLE;
  13721. *
  13722. *****************************************************************
  13723. * PROCEDURE DE DETERMINATION DE L'ANGLE D'INCIDENCE MAX : ALPHA *
  13724. *****************************************************************
  13725. *
  13726. MESS '---------------------------------> calling @INCI';
  13727. MESS 'Calcul de l angle d incidence par le code';
  13728. *
  13729. *--------------- VARIABLES D'ENTREE :
  13730. MAIL0 = TAB1.<V_OMBRANT_N ;
  13731. CONT0 = TAB1.<S_OMBRANT_N ;
  13732. TYPCAL = TAB1.<TYPE_CALCUL ;
  13733. *------------------------------------
  13734. *
  13735. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  13736. ISHIFT = VRAI ;
  13737. IRIPPLE = VRAI ;
  13738. FINSI ;
  13739. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  13740. ISHIFT = VRAI ;
  13741. IRIPPLE = FAUX ;
  13742. FINSI ;
  13743. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  13744. ISHIFT = FAUX ;
  13745. IRIPPLE = VRAI ;
  13746. FINSI ;
  13747. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  13748. ISHIFT = FAUX ;
  13749. IRIPPLE = FAUX ;
  13750. FINSI ;
  13751. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  13752. ERRE ' >>>> @INCI : check the value of TAB1.<TYPE_CALCUL';
  13753. FINSI ;
  13754. *
  13755. *
  13756. *---- coordonnees dans le repere du maillage
  13757. XM = COOR 1 CONT0 ;
  13758. YM = COOR 2 CONT0 ;
  13759. SI ((VALEUR DIME) EGA 2) ;
  13760. ZM = XM * 0. ;
  13761. SINON ;
  13762. ZM = COOR 3 CONT0 ;
  13763. FINSI ;
  13764. *
  13765. *---- coordonnees dans le repere global
  13766. XG YG ZG = @CRMGC XM YM ZM TAB1 ;
  13767. MENAGE ;
  13768. *
  13769. *---- calcul du champ magnetique dans le repere global
  13770. BXG BYG BZG FSECU = @CHAMB TAB1 XG YG ZG ISHIFT IRIPPLE ;
  13771. MENAGE ;
  13772. *
  13773. *---- composantes de B dans le repere du maillage
  13774. BXM BYM BZM = @CBGMV BXG BYG BZG TAB1 ;
  13775. MENAGE ;
  13776. *
  13777. *---- calcul des normales a la surface calculees
  13778. *---- dans le repere du maillage
  13779. MESS 'APPEL DE VNORM3D POUR LE MAILLAGE OMBRANT';
  13780. NXM NYM NZM = @VNORM3D MAIL0 CONT0 ;
  13781. MENAGE ;
  13782. *
  13783. *---- calcul du produit scalaire et de l'angle d'incidence
  13784. B_NORM = ((BXM*BXM) + (BYM*BYM) + (BZM*BZM))**0.5 ;
  13785. VBVN = (ABS ((BXM*NXM) + (BYM*NYM) + (BZM*NZM))) / B_NORM;
  13786. ANGINCI = ATG ((1.-(VBVN**2))**0.5) VBVN ;
  13787. *
  13788. CHALPHA = ABS (90. - ANGINCI) ;
  13789. ALPHA = MAXI CHALPHA ;
  13790. MESS '>@INCI> Incidence maximale en degres :'ALPHA ;
  13791.  
  13792. MESS '---------------------------------> exiting @INCI';
  13793. FINPROC ALPHA ;
  13794. debproc @inertid geo1*maillage point1*point point2*point ;
  13795.  
  13796. *
  13797. * --- definition d'un modele articifiel pour les mchaml
  13798. *
  13799. mod1 = MODE geo1 mecanique elastique ;
  13800. *
  13801. * --- definition des champs de coordonnees
  13802. *
  13803. chpx1 = nomc scal (coor 1 geo1) ;
  13804. chpy1 = nomc scal (coor 2 geo1) ;
  13805. *
  13806. * ---
  13807. *
  13808. chmx2 = chan cham chpx1 geo1 bidon ;
  13809. chmy2 = chan cham chpy1 geo1 bidon ;
  13810. *
  13811. * ---
  13812. *
  13813. chmx1 = chan gravite mod1 chmx2 ;
  13814. chmy1 = chan gravite mod1 chmy2 ;
  13815. *
  13816. * --- aa1, bb1 et cc1 sont les coeffcients de l'equation cartesienne
  13817. * de la droite passant par point1 et point2
  13818. *
  13819. x1 = coor 1 point1 ;
  13820. y1 = coor 2 point1 ;
  13821. x2 = coor 1 point2 ;
  13822. y2 = coor 2 point2 ;
  13823.  
  13824. si (ega x1 x2 ) ;
  13825. si (ega y1 y2) ;
  13826. erre '>@inertie> les deux points sont confondus';
  13827. sinon ;
  13828. aa1 = 1. ;
  13829. bb1 = 0. ;
  13830. cc1 = -1. * x1 ;
  13831. finsi ;
  13832. sinon ;
  13833. aa1 = 1./(x2 - x1);
  13834. si (ega y1 y2) ;
  13835. aa1 = 0. ;
  13836. bb1 = 1. ;
  13837. cc1 = -1. * y1 ;
  13838. sinon ;
  13839. bb1 = -1./(y2 - y1);
  13840. cc1 = (x1 * aa1) + (x2 * bb1) * -1.;
  13841. finsi ;
  13842. finsi ;
  13843.  
  13844. cc2 = manu chml mod1 scal cc1 type bidon gravite;
  13845. den1 = ((aa1*aa1)+(bb1*bb1))**.5 ;
  13846. *
  13847. * --- chmd1 est le mchaml qui contient la distance des centres
  13848. * de gravite des elements de geo1 a la droite passant par
  13849. * point1 et point2
  13850. *
  13851. chmd1 = (abs((chmx1*aa1) + (chmy1*bb1) + cc2))/den1 ;
  13852. *
  13853. * --- intergration du carre du champs
  13854. *
  13855. i1 = intg mod1 (chmd1 ** 2.) ;
  13856.  
  13857. finproc i1 ;
  13858.  
  13859. debproc @inertie geo1*maillage vec1*point ;
  13860.  
  13861. *
  13862. * --- definition d'un modele articifiel pour les mchaml
  13863. *
  13864. mod1 = MODE geo1 mecanique elastique ;
  13865. *
  13866. * --- definition des champs de coordonnees
  13867. *
  13868. chpx1 = nomc scal (coor 1 geo1) ;
  13869. chpy1 = nomc scal (coor 2 geo1) ;
  13870. *
  13871. * ---
  13872. *
  13873. chmx2 = chan cham chpx1 geo1 bidon ;
  13874. chmy2 = chan cham chpy1 geo1 bidon ;
  13875. *
  13876. * ---
  13877. *
  13878. chmx1 = chan gravite mod1 chmx2 ;
  13879. chmy1 = chan gravite mod1 chmy2 ;
  13880. *
  13881. * --- on calcule la position du centre de gravite de la section
  13882. *
  13883. ss1 = mesu geo1 ;
  13884. gx1 = (intg mod1 chmx1) / ss1 ;
  13885. gy1 = (intg mod1 chmy1) / ss1 ;
  13886.  
  13887.  
  13888.  
  13889. *
  13890. * --- aa1, bb1 et cc1 sont les coeffcients de l'equation cartesienne
  13891. * de la droite passant par point1 et point2
  13892. *
  13893. x2 = coor 1 vec1 ;
  13894. y2 = coor 2 vec1 ;
  13895.  
  13896. aa1 = y2 ;
  13897. bb1 = -1. * x2 ;
  13898. cc1 = x2 * gx1 - (y2 * gx1) ;
  13899. cc2 = manu chml mod1 scal cc1 type bidon gravite;
  13900. den1 = ((aa1*aa1)+(bb1*bb1))**.5 ;
  13901. *
  13902. * --- chmd1 est le mchaml qui contient la distance des centres
  13903. * de gravite des elements de geo1 a la droite passant par
  13904. * le centre de gravite et la direction definie par le vecteur1
  13905. *
  13906. chmd1 = (abs((chmx1*aa1) + (chmy1*bb1) + cc2))/den1 ;
  13907. *
  13908. * --- intergration du carre du champs
  13909. *
  13910. i1 = intg mod1 (chmd1 ** 2.) ;
  13911.  
  13912. finproc (gx1 gy1) i1 ;
  13913.  
  13914. **** @INTERC
  13915.  
  13916. DEBPROC @INTERC CH_OLD2*CHPOINT CH_NEW2*CHPOINT TOL2*FLOTTANT TAB1*TABLE ;
  13917.  
  13918. *MESS '---------------------------------> calling @INTERC';
  13919.  
  13920. S_OMBRE4 = CH_OLD2 EXTR MAIL ;
  13921. dex4 = nomc scal (exco x (CH_NEW2 - CH_OLD2));
  13922. dey4 = nomc scal (exco y (CH_NEW2 - CH_OLD2));
  13923. dez4 = nomc scal (exco z (CH_NEW2 - CH_OLD2));
  13924.  
  13925. xinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
  13926. yinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
  13927. zinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
  13928.  
  13929. *
  13930. * +++++++++++++++++++++++++++++++++++
  13931. * RECHERCHE DES INTERCECTIONS
  13932. * +++++++++++++++++++++++++++++++++++
  13933. *
  13934. * METHODE CHOISIE: on boucle sur les facettes et on travaille sur les
  13935. * champs par points des points remontes. Cette methode est adaptee
  13936. * a un maillage ombrant reduit et a un maillage ombre volumineux...
  13937. *
  13938.  
  13939. * --- CHAMP CONTENANT N POUR LES NEOUDS DE OMBRE INTERSECTES N FOIS
  13940. *CHINTER2 = manu chpo S_OMBRE4 1 scal 0. 'NATURE' 'DISCRET' ;
  13941. CHINTER2 = manu chpo S_OMBRE4 1 scal 0. ;
  13942.  
  13943. S_OMBRA3 = extr tab1.<chamx1 mail ;
  13944. nel1 = nbel S_OMBRA3 ;
  13945.  
  13946. repe boucel1 nel1;
  13947.  
  13948. * mess 'facette numero' &boucel1 ;
  13949.  
  13950. el1 = S_OMBRA3 elem &boucel1 ;
  13951.  
  13952. * on extrait les coordonnees du point A de la facette
  13953. xa1 = extr tab1.<chamx1 scal 1 &boucel1 1 ;
  13954. ya1 = extr tab1.<chamy1 scal 1 &boucel1 1 ;
  13955. za1 = extr tab1.<chamz1 scal 1 &boucel1 1 ;
  13956. *
  13957. xb1 = extr tab1.<chamx2 scal 1 &boucel1 1 ;
  13958. yb1 = extr tab1.<chamy2 scal 1 &boucel1 1 ;
  13959. zb1 = extr tab1.<chamz2 scal 1 &boucel1 1 ;
  13960. *
  13961. xc1 = extr tab1.<chamx3 scal 1 &boucel1 1 ;
  13962. yc1 = extr tab1.<chamy3 scal 1 &boucel1 1 ;
  13963. zc1 = extr tab1.<chamz3 scal 1 &boucel1 1 ;
  13964.  
  13965. * on calcule les vecteurs APn et APn+1
  13966. apnx1 = (exco X CH_OLD2) - xa1 ;
  13967. apny1 = (exco Y CH_OLD2) - ya1 ;
  13968. apnz1 = (exco Z CH_OLD2) - za1 ;
  13969.  
  13970. apnp1x1 = (exco x CH_NEW2) - xa1 ;
  13971. apnp1y1 = (exco y CH_NEW2) - ya1 ;
  13972. apnp1z1 = (exco z CH_NEW2) - za1 ;
  13973.  
  13974. * on extrait les cosinus directeurs de la normale de la facette
  13975. nfx1 = extr tab1.<cosx scal 1 &boucel1 1;
  13976. nfy1 = extr tab1.<cosy scal 1 &boucel1 1;
  13977. nfz1 = extr tab1.<cosz scal 1 &boucel1 1;
  13978.  
  13979. * on effectue les produits scalaires.
  13980. ps1 = (apnx1 * nfx1) + (apny1 * nfy1) + (apnz1 * nfz1);
  13981. ps2 = (apnp1x1 * nfx1) + (apnp1y1 * nfy1) + (apnp1z1 * nfz1);
  13982. pp1 = ps1*ps2 ;
  13983.  
  13984. * la je suis dans la facette i et je determine quels sont les segments
  13985. * PnPn+1 qui traversent le plan de la facette.
  13986. * si le produit scalaire est nul, c'est que un des noeuds p1 ou p2 est
  13987. * dans le plan de la facette
  13988.  
  13989. * segments de part et d'autre de la facette
  13990. mail3 = pp1 poin infe (-1.*tol2*tol2) ;
  13991. * si Pn+1 appartient au maillage ombrant
  13992. mail6 = ps2 poin egale 0. ;
  13993. mail7 = mail3 et mail6 ;
  13994. n_mail7 = nbno mail7 ;
  13995. si (ega (n_mail7) 0) ;
  13996. iter boucel1;
  13997. finsi ;
  13998.  
  13999. * mail3 est le maillage des noeuds de mail2 pour lesquels le segment incremente
  14000. * le long de la ligne de champ intersecte (largement)le plan de la facette
  14001. * en cours... c'est a dire qu'on inclut les cas ou Pn ou Pn+1 sont dans le plan
  14002. * de la facette
  14003. * on va calculer le point d'intersection que pour ces points la.
  14004.  
  14005. dex2 = redu dex4 (mail7) ;
  14006. dey2 = redu dey4 (mail7) ;
  14007. dez2 = redu dez4 (mail7) ;
  14008.  
  14009. chr1 = redu CH_OLD2 (mail7) ;
  14010. chr2 = redu CH_NEW2 (mail7) ;
  14011.  
  14012. chrx1 = nomc scal (exco chr1 x) ;
  14013. chry1 = nomc scal (exco chr1 y) ;
  14014. chrz1 = nomc scal (exco chr1 z) ;
  14015.  
  14016.  
  14017. ad1 = (dex2 * nfx1) + (dey2 * nfy1) + (dez2 * nfz1) ;
  14018. * mess 'ad1' ;(list ad1) ;
  14019. * on exclu avec une tolerence, les segments qui sont paralleles a la facette
  14020. * => on considere qu'il n'y a pas d'intersection pour ces noeuds la
  14021. mail4 = (abs ad1) poin superieur TOL2 ;
  14022. n_mail4 = nbno mail4 ;
  14023. * mess 'nb de segments non // a la facette' n_mail4 ;
  14024. si (ega n_mail4 0) ;
  14025. iter boucel1;
  14026. finsi ;
  14027. ad2 = redu ad1 mail4 ;
  14028. dex3 = redu dex2 mail4 ;
  14029. dey3 = redu dey2 mail4 ;
  14030. dez3 = redu dez2 mail4 ;
  14031. chrx2 = redu chrx1 mail4 ;
  14032. chry2 = redu chry1 mail4 ;
  14033. chrz2 = redu chrz1 mail4 ;
  14034.  
  14035. bx1 = (xa1*dex3*nfx1) - ((((chry2-ya1)*dex3)-(chrx2*dey3))*nfy1) - ((((chrz2-za1)*dex3)-(chrx2*dez3))*nfz1);
  14036.  
  14037. by1 = (ya1*dey3*nfy1) - ((((chrz2-za1)*dey3)-(chry2*dez3))*nfz1) - ((((chrx2-xa1)*dey3)-(chry2*dex3))*nfx1);
  14038.  
  14039. bz1 = (za1*dez2*nfz1) - ((((chrx2-xa1)*dez3)-(chrz2*dex3))*nfx1) - ((((chry2-ya1)*dez3)-(chrz2*dey3))*nfy1);
  14040. xm1 = bx1 / ad2 ;
  14041. ym1 = by1 / ad2 ;
  14042. zm1 = bz1 / ad2 ;
  14043.  
  14044. * xm1, ym1 et zm1 sont des champs par points definis sur mail7,
  14045. * maillage des points de mail2 (ombre) dont les segments incrementes
  14046. * du pas n interseptent la facette en cours. Ces champs par points
  14047. * contiennent les coordonnees des intersections entre le segment
  14048. * du point considere avec le plan de la facette courante.
  14049.  
  14050.  
  14051. * maintenant, on va chercher les coordonnes barycentriques de M dans
  14052. * le repere baryentrique forme par les trois sommets de la facette
  14053. * en cours A, B, C.
  14054.  
  14055. dxa1 = xm1 - xa1 ;
  14056. dxb1 = xm1 - xb1 ;
  14057. dxc1 = xm1 - xc1 ;
  14058. dya1 = ym1 - ya1 ;
  14059. dyb1 = ym1 - yb1 ;
  14060. dyc1 = ym1 - yc1 ;
  14061. dza1 = zm1 - za1 ;
  14062. dzb1 = zm1 - zb1 ;
  14063. dzc1 = zm1 - zc1 ;
  14064.  
  14065. * denominateur suivant les 3 axes :
  14066. Dz = (dyc1*dxb1)-(dxc1*dyb1)+(dxa1*dyb1)-(dxa1*dyc1)-(dya1*dxb1) +(dya1*dxc1) ;
  14067. Dy = (dzc1*dxb1)-(dxc1*dzb1)+(dxa1*dzb1)-(dxa1*dzc1)-(dza1*dxb1) +(dza1*dxc1) ;
  14068. Dx = (dyc1*dzb1)-(dzc1*dyb1)+(dza1*dyb1)-(dza1*dyc1)-(dya1*dzb1) +(dya1*dzc1) ;
  14069. *
  14070. *
  14071. si ((maxi (abs Dz)) > tol2) ;
  14072. D1 = Dz ;
  14073. a1 = (dyc1*dxb1) - (dxc1*dyb1) ;
  14074. b1 = (dya1*dxc1) - (dxa1*dyc1) ;
  14075. c1 = (dyb1*dxa1) - (dxb1*dya1) ;
  14076. sinon ;
  14077. si ((maxi (abs Dy)) > tol2) ;
  14078. D1 = Dy ;
  14079. a1 = (dzc1*dxb1) - (dxc1*dzb1) ;
  14080. b1 = (dza1*dxc1) - (dxa1*dzc1) ;
  14081. c1 = (dzb1*dxa1) - (dxb1*dza1) ;
  14082. sinon ;
  14083. D1 = Dx ;
  14084. a1 = (dyc1*dzb1) - (dzc1*dyb1) ;
  14085. b1 = (dya1*dzc1) - (dza1*dyc1) ;
  14086. c1 = (dyb1*dza1) - (dzb1*dya1) ;
  14087. finsi ;
  14088. finsi ;
  14089.  
  14090. * calcul de alpha1
  14091. alpha1 = a1 / D1 ;
  14092.  
  14093. * calcul de beta1
  14094. beta1 = b1 / D1 ;
  14095. *
  14096. * calcul de gamma1
  14097. gamma1 = c1 / D1 ;
  14098.  
  14099.  
  14100. * si alpha et beta et gama sont tous superieurs ou egaux a 0,
  14101. * le point d'intersection est dans la facette et il y a intersection
  14102.  
  14103. * CHPO CONTENANT 1 POUR LES NOEUDS INTERSECTES PAR LA FACETTE COURANTE
  14104. CHINTER1 = (alpha1 masque egsupe 0.) * (beta1 masque egsupe 0.) * (gamma1 masque egsupe 0.) ;
  14105.  
  14106. * PTPRIS1 = CHINTER1 POIN DIFF 0. ;
  14107. * mess 'nb noeuds intersectes (pour la facette) =' (nbno PTPRIS1);
  14108.  
  14109. * maillage de noeuds n'ayant pas deja ete intersectes
  14110. chinter3 = CHINTER1 - CHINTER2 ;
  14111. mail5 = (abs (chinter3 - 1.)) poin inferieur TOL2 ;
  14112.  
  14113. * CHPO CONTENANT N POUR LES NOEUDS INTERSECTES PAR N FACETTES
  14114. CHINTER2 = CHINTER1 + CHINTER2 ;
  14115.  
  14116. * PTPRIS2 = CHINTER2 POIN DIFF 0. ;
  14117. * mess 'nb noeuds intersectes (pour ttes les facettes) =' (nbno PTPRIS2);
  14118.  
  14119. * on calcule des CHPO reduits aux noeuds intersectes
  14120. xm1_r = redu xm1 mail5 ;
  14121. ym1_r = redu ym1 mail5 ;
  14122. zm1_r = redu zm1 mail5 ;
  14123. xm1_r = chan 'ATTRIBUT' xm1_r nature discret ;
  14124. ym1_r = chan 'ATTRIBUT' ym1_r nature discret ;
  14125. zm1_r = chan 'ATTRIBUT' zm1_r nature discret ;
  14126.  
  14127. * concatenation des coordonnees des intersections
  14128. xinter1 = xinter1 et xm1_r ;
  14129. yinter1 = yinter1 et ym1_r ;
  14130. zinter1 = zinter1 et zm1_r ;
  14131.  
  14132. mena ;
  14133.  
  14134. fin boucel1 ;
  14135. * -- Fin de la grande boucle sur les facettes intersectantes --
  14136.  
  14137. * maillage contenant les noeuds intersectes
  14138. minter1 = chinter2 poin different 0. ;
  14139.  
  14140. *** RM diagnostic
  14141. *mess 'nbno minter1' (nbno minter1) ;
  14142. *mess 'xinter1' ;
  14143. *@listmm xinter1 ;
  14144. *mess 'yinter1' ;
  14145. *@listmm yinter1 ;
  14146. *mess 'zinter1' ;
  14147. *@listmm zinter1 ;
  14148. *** RM fin diagnostic
  14149.  
  14150. * difference symetrique (ou l'on impose PAS)
  14151. nointer1 = diff minter1 S_OMBRE4 ;
  14152.  
  14153. * calcul du pas sur tout le maillage s_ombre4
  14154. chpas0 = ((dex4 * dex4) + (dey4 * dey4) + (dez4 * dez4)) ** 0.5 ;
  14155.  
  14156. * distances entre points initiaux et M (uniquement sur noeuds inters)
  14157.  
  14158. si ((nbno minter1) > 0) ;
  14159. xinter1r = redu xinter1 minter1 ;
  14160. yinter1r = redu yinter1 minter1 ;
  14161. zinter1r = redu zinter1 minter1 ;
  14162.  
  14163. CH_OLD2r = redu CH_OLD2 minter1 ;
  14164. xp1 = exco X CH_OLD2r ;
  14165. yp1 = exco Y CH_OLD2r ;
  14166. zp1 = exco Z CH_OLD2r ;
  14167.  
  14168. dxmp1 = xp1 - xinter1r ;
  14169. dymp1 = yp1 - yinter1r ;
  14170. dzmp1 = zp1 - zinter1r ;
  14171.  
  14172. chdmp1 = ((dxmp1 * dxmp1) + (dymp1 * dymp1) + (dzmp1 * dzmp1)) ** 0.5 ;
  14173. chdmp1 = chan 'ATTRIBUT' chdmp1 nature diffus ;
  14174.  
  14175. si ((nbno nointer1) > 0) ;
  14176. * on peut avoit tout intersecte auquel cas on n a pas a mettre le
  14177. * pas pour les autres
  14178. chdist1 = redu chpas0 nointer1 ;
  14179. chdist1 = chan 'ATTRIBUT' chdist1 nature diffus ;
  14180. chdist8 = chdist1 et chdmp1 ;
  14181. sinon ;
  14182. chdist8 = chdmp1 ;
  14183. finsi ;
  14184. sinon ;
  14185. chdist8 = chpas0 ;
  14186. finsi ;
  14187.  
  14188. chdist9 = chan 'ATTRIBUT' chdist8 nature discret ;
  14189.  
  14190. *MESS '---------------------------------> exiting @INTERC';
  14191.  
  14192. FINPROC chdist9 minter1 ;
  14193.  
  14194. debproc inters mail1*maillage p1*maillage p2*maillage ;
  14195.  
  14196. finproc ;
  14197. **** @INTSEC
  14198.  
  14199. DEBPROC @INTSEC CH_OLD2*CHPOINT CH_NEW2*CHPOINT TOL2*FLOTTANT TAB1*TABLE ;
  14200. *
  14201. **********************************************
  14202. * Procedure (inspiree de @INTERC) calculant *
  14203. * l'intersection des lignes de champ avec un *
  14204. * objet constitue de facettes triangulaires *
  14205. * par une methode analytique exacte. *
  14206. * Alain MOAL (Fevrier 2001) *
  14207. **********************************************
  14208. *
  14209. *MESS '---------------------------------> calling @INTSEC';
  14210.  
  14211. S_OMBRE4 = CH_OLD2 EXTR MAIL ;
  14212. dex4 = nomc scal (exco x (CH_NEW2 - CH_OLD2));
  14213. dey4 = nomc scal (exco y (CH_NEW2 - CH_OLD2));
  14214. dez4 = nomc scal (exco z (CH_NEW2 - CH_OLD2));
  14215.  
  14216. xinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
  14217. yinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
  14218. zinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
  14219. finter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
  14220. *
  14221. * +++++++++++++++++++++++++++++++++++
  14222. * RECHERCHE DES INTERCECTIONS
  14223. * +++++++++++++++++++++++++++++++++++
  14224. *
  14225. * METHODE CHOISIE: on boucle sur les facettes et on travaille sur les
  14226. * champs par points des points remontes. Cette methode est adaptee
  14227. * a un maillage ombrant reduit et a un maillage ombre volumineux...
  14228. *
  14229. * --- CHAMP CONTENANT N POUR LES NOEUDS DE OMBRE INTERSECTES N FOIS
  14230. *CHINTER2 = manu chpo S_OMBRE4 1 scal 0. 'NATURE' 'DISCRET' ;
  14231. CHINTER2 = manu chpo S_OMBRE4 1 scal 0. ;
  14232.  
  14233. S_OMBRA3 = extr tab1.<chelx1 mail ;
  14234. nel1 = nbel S_OMBRA3 ;
  14235.  
  14236. repe boucel1 nel1;
  14237.  
  14238. * mess 'facette numero' &boucel1 ;
  14239.  
  14240. el1 = S_OMBRA3 elem &boucel1 ;
  14241.  
  14242. * on extrait les coordonnees du point A de la facette
  14243. xa1 = extr tab1.<chelx1 scal 1 &boucel1 1 ;
  14244. ya1 = extr tab1.<chely1 scal 1 &boucel1 1 ;
  14245. za1 = extr tab1.<chelz1 scal 1 &boucel1 1 ;
  14246. *
  14247. xb1 = extr tab1.<chelx2 scal 1 &boucel1 1 ;
  14248. yb1 = extr tab1.<chely2 scal 1 &boucel1 1 ;
  14249. zb1 = extr tab1.<chelz2 scal 1 &boucel1 1 ;
  14250. *
  14251. xc1 = extr tab1.<chelx3 scal 1 &boucel1 1 ;
  14252. yc1 = extr tab1.<chely3 scal 1 &boucel1 1 ;
  14253. zc1 = extr tab1.<chelz3 scal 1 &boucel1 1 ;
  14254.  
  14255. * on extrait le flux normalise en chaque point de la facette
  14256. f1 = extr tab1.<chamf1 scal 1 &boucel1 1 ;
  14257. f2 = extr tab1.<chamf2 scal 1 &boucel1 1 ;
  14258. f3 = extr tab1.<chamf3 scal 1 &boucel1 1 ;
  14259.  
  14260. * on calcule les vecteurs APn et APn+1
  14261. apnx1 = (exco X CH_OLD2) - xa1 ;
  14262. apny1 = (exco Y CH_OLD2) - ya1 ;
  14263. apnz1 = (exco Z CH_OLD2) - za1 ;
  14264.  
  14265. apnp1x1 = (exco x CH_NEW2) - xa1 ;
  14266. apnp1y1 = (exco y CH_NEW2) - ya1 ;
  14267. apnp1z1 = (exco z CH_NEW2) - za1 ;
  14268.  
  14269. * on extrait les cosinus directeurs de la normale de la facette
  14270. nfx1 = extr tab1.<cosinusx scal 1 &boucel1 1;
  14271. nfy1 = extr tab1.<cosinusy scal 1 &boucel1 1;
  14272. nfz1 = extr tab1.<cosinusz scal 1 &boucel1 1;
  14273.  
  14274. * on effectue les produits scalaires.
  14275. ps1 = (apnx1 * nfx1) + (apny1 * nfy1) + (apnz1 * nfz1);
  14276. ps2 = (apnp1x1 * nfx1) + (apnp1y1 * nfy1) + (apnp1z1 * nfz1);
  14277. pp1 = ps1*ps2 ;
  14278.  
  14279. * la je suis dans la facette i et je determine quels sont les segments
  14280. * PnPn+1 qui traversent le plan de la facette.
  14281. * si le produit scalaire est nul, c'est que un des noeuds p1 ou p2 est
  14282. * dans le plan de la facette
  14283.  
  14284. * segments de part et d'autre de la facette
  14285. mail3 = pp1 poin infe (-1.*tol2*tol2) ;
  14286. * si Pn+1 appartient au maillage ombrant
  14287. mail6 = ps2 poin egale 0. ;
  14288. mail7 = mail3 et mail6 ;
  14289. n_mail7 = nbno mail7 ;
  14290. si (ega (n_mail7) 0) ;
  14291. iter boucel1;
  14292. finsi ;
  14293.  
  14294. * mail3 est le maillage des noeuds de mail2 pour lesquels le segment incremente
  14295. * le long de la ligne de champ intersecte (largement)le plan de la facette
  14296. * en cours... c'est a dire qu'on inclut les cas ou Pn ou Pn+1 sont dans le plan
  14297. * de la facette
  14298. * on va calculer le point d'intersection que pour ces points la.
  14299.  
  14300. dex2 = redu dex4 (mail7) ;
  14301. dey2 = redu dey4 (mail7) ;
  14302. dez2 = redu dez4 (mail7) ;
  14303.  
  14304. chr1 = redu CH_OLD2 (mail7) ;
  14305. chr2 = redu CH_NEW2 (mail7) ;
  14306.  
  14307. chrx1 = nomc scal (exco chr1 x) ;
  14308. chry1 = nomc scal (exco chr1 y) ;
  14309. chrz1 = nomc scal (exco chr1 z) ;
  14310.  
  14311.  
  14312. ad1 = (dex2 * nfx1) + (dey2 * nfy1) + (dez2 * nfz1) ;
  14313. * mess 'ad1' ;(list ad1) ;
  14314. * on exclu avec une tolerence, les segments qui sont paralleles a la facette
  14315. * => on considere qu'il n'y a pas d'intersection pour ces noeuds la
  14316. mail4 = (abs ad1) poin superieur TOL2 ;
  14317. n_mail4 = nbno mail4 ;
  14318. * mess 'nb de segments non // a la facette' n_mail4 ;
  14319. si (ega n_mail4 0) ;
  14320. iter boucel1;
  14321. finsi ;
  14322. ad2 = redu ad1 mail4 ;
  14323. dex3 = redu dex2 mail4 ;
  14324. dey3 = redu dey2 mail4 ;
  14325. dez3 = redu dez2 mail4 ;
  14326. chrx2 = redu chrx1 mail4 ;
  14327. chry2 = redu chry1 mail4 ;
  14328. chrz2 = redu chrz1 mail4 ;
  14329.  
  14330. bx1 = (xa1*dex3*nfx1) - ((((chry2-ya1)*dex3)-(chrx2*dey3))*nfy1) - ((((chrz2-za1)*dex3)-(chrx2*dez3))*nfz1);
  14331.  
  14332. by1 = (ya1*dey3*nfy1) - ((((chrz2-za1)*dey3)-(chry2*dez3))*nfz1) - ((((chrx2-xa1)*dey3)-(chry2*dex3))*nfx1);
  14333.  
  14334. bz1 = (za1*dez2*nfz1) - ((((chrx2-xa1)*dez3)-(chrz2*dex3))*nfx1) - ((((chry2-ya1)*dez3)-(chrz2*dey3))*nfy1);
  14335. xm1 = bx1 / ad2 ;
  14336. ym1 = by1 / ad2 ;
  14337. zm1 = bz1 / ad2 ;
  14338.  
  14339. * xm1, ym1 et zm1 sont des champs par points definis sur mail7,
  14340. * maillage des points de mail2 (ombre) dont les segments incrementes
  14341. * du pas n interseptent la facette en cours. Ces champs par points
  14342. * contiennent les coordonnees des intersections entre le segment
  14343. * du point considere avec le plan de la facette courante.
  14344.  
  14345.  
  14346. * maintenant, on va chercher les coordonnes barycentriques de M dans
  14347. * le repere baryentrique forme par les trois sommets de la facette
  14348. * en cours A, B, C.
  14349.  
  14350. dxa1 = xm1 - xa1 ;
  14351. dxb1 = xm1 - xb1 ;
  14352. dxc1 = xm1 - xc1 ;
  14353. dya1 = ym1 - ya1 ;
  14354. dyb1 = ym1 - yb1 ;
  14355. dyc1 = ym1 - yc1 ;
  14356. dza1 = zm1 - za1 ;
  14357. dzb1 = zm1 - zb1 ;
  14358. dzc1 = zm1 - zc1 ;
  14359.  
  14360. * denominateur suivant les 3 axes :
  14361. Dz = (dyc1*dxb1)-(dxc1*dyb1)+(dxa1*dyb1)-(dxa1*dyc1)-(dya1*dxb1) +(dya1*dxc1) ;
  14362. Dy = (dzc1*dxb1)-(dxc1*dzb1)+(dxa1*dzb1)-(dxa1*dzc1)-(dza1*dxb1) +(dza1*dxc1) ;
  14363. Dx = (dyc1*dzb1)-(dzc1*dyb1)+(dza1*dyb1)-(dza1*dyc1)-(dya1*dzb1) +(dya1*dzc1) ;
  14364. *
  14365. *
  14366. si ((maxi (abs Dz)) > tol2) ;
  14367. D1 = Dz ;
  14368. a1 = (dyc1*dxb1) - (dxc1*dyb1) ;
  14369. b1 = (dya1*dxc1) - (dxa1*dyc1) ;
  14370. c1 = (dyb1*dxa1) - (dxb1*dya1) ;
  14371. sinon ;
  14372. si ((maxi (abs Dy)) > tol2) ;
  14373. D1 = Dy ;
  14374. a1 = (dzc1*dxb1) - (dxc1*dzb1) ;
  14375. b1 = (dza1*dxc1) - (dxa1*dzc1) ;
  14376. c1 = (dzb1*dxa1) - (dxb1*dza1) ;
  14377. sinon ;
  14378. D1 = Dx ;
  14379. a1 = (dyc1*dzb1) - (dzc1*dyb1) ;
  14380. b1 = (dya1*dzc1) - (dza1*dyc1) ;
  14381. c1 = (dyb1*dza1) - (dzb1*dya1) ;
  14382. finsi ;
  14383. finsi ;
  14384.  
  14385. * calcul de alpha1
  14386. alpha1 = a1 / D1 ;
  14387.  
  14388. * calcul de beta1
  14389. beta1 = b1 / D1 ;
  14390. *
  14391. * calcul de gamma1
  14392. gamma1 = c1 / D1 ;
  14393. *
  14394. * flux normalise au point trouve (sur un triangle a 3 noeuds
  14395. * les fonctions de forme sont les coordonnees barycentriques)
  14396. fm0 = (alpha1 * f1) + (beta1 * f2) + (gamma1 * f3) ;
  14397.  
  14398. * si alpha et beta et gama sont tous superieurs ou egaux a 0,
  14399. * le point d'intersection est dans la facette et il y a intersection
  14400.  
  14401. * CHPO CONTENANT 1 POUR LES NOEUDS INTERSECTES PAR LA FACETTE COURANTE
  14402. CHINTER1 = (alpha1 masque egsupe 0.) * (beta1 masque egsupe 0.) * (gamma1 masque egsupe 0.) ;
  14403.  
  14404. * PTPRIS1 = CHINTER1 POIN DIFF 0. ;
  14405. * mess 'nb noeuds intersectes (pour la facette) =' (nbno PTPRIS1);
  14406.  
  14407. * maillage de noeuds n'ayant pas deja ete intersectes
  14408. chinter3 = CHINTER1 - CHINTER2 ;
  14409. mail5 = (abs (chinter3 - 1.)) poin inferieur TOL2 ;
  14410.  
  14411. * CHPO CONTENANT N POUR LES NOEUDS INTERSECTES PAR N FACETTES
  14412. CHINTER2 = CHINTER1 + CHINTER2 ;
  14413.  
  14414. * PTPRIS2 = CHINTER2 POIN DIFF 0. ;
  14415. * mess 'nb noeuds intersectes (pour ttes les facettes) =' (nbno PTPRIS2);
  14416.  
  14417. * on calcule des CHPO reduits aux noeuds intersectes
  14418. xm1_r = redu xm1 mail5 ;
  14419. ym1_r = redu ym1 mail5 ;
  14420. zm1_r = redu zm1 mail5 ;
  14421. xm1_r = chan 'ATTRIBUT' xm1_r nature discret ;
  14422. ym1_r = chan 'ATTRIBUT' ym1_r nature discret ;
  14423. zm1_r = chan 'ATTRIBUT' zm1_r nature discret ;
  14424. fm0_r = redu fm0 mail5 ;
  14425. fm0_r = chan 'ATTRIBUT' fm0_r nature discret ;
  14426.  
  14427.  
  14428. * concatenation des coordonnees des intersections
  14429. xinter1 = xinter1 et xm1_r ;
  14430. yinter1 = yinter1 et ym1_r ;
  14431. zinter1 = zinter1 et zm1_r ;
  14432.  
  14433. * concatenation du flux normalise aux points d'intersection
  14434. finter1 = finter1 et fm0_r ;
  14435.  
  14436.  
  14437. fin boucel1 ;
  14438. * -- Fin de la grande boucle sur les facettes intersectantes --
  14439.  
  14440. * maillage contenant les noeuds intersectes
  14441. minter1 = chinter2 poin different 0. ;
  14442.  
  14443. * difference symetrique (ou l'on impose PAS)
  14444. nointer1 = diff minter1 S_OMBRE4 ;
  14445.  
  14446. * calcul du pas sur tout le maillage s_ombre4
  14447. chpas0 = ((dex4 * dex4) + (dey4 * dey4) + (dez4 * dez4)) ** 0.5 ;
  14448.  
  14449. * flux normalise initialise sur le maillage s_ombre4
  14450. chfn0 = manu chpo S_OMBRE4 1 scal 0. ;
  14451.  
  14452. * distances entre points initiaux et M (uniquement sur noeuds inters)
  14453.  
  14454. si ((nbno minter1) > 0) ;
  14455. xinter1r = redu xinter1 minter1 ;
  14456. yinter1r = redu yinter1 minter1 ;
  14457. zinter1r = redu zinter1 minter1 ;
  14458.  
  14459. finter1r = redu finter1 minter1 ;
  14460. finter1r = chan 'ATTRIBUT' finter1r nature diffus ;
  14461.  
  14462. CH_OLD2r = redu CH_OLD2 minter1 ;
  14463. xp1 = exco X CH_OLD2r ;
  14464. yp1 = exco Y CH_OLD2r ;
  14465. zp1 = exco Z CH_OLD2r ;
  14466.  
  14467. dxmp1 = xp1 - xinter1r ;
  14468. dymp1 = yp1 - yinter1r ;
  14469. dzmp1 = zp1 - zinter1r ;
  14470.  
  14471. chdmp1 = ((dxmp1 * dxmp1) + (dymp1 * dymp1) + (dzmp1 * dzmp1)) ** 0.5 ;
  14472. chdmp1 = chan 'ATTRIBUT' chdmp1 nature diffus ;
  14473.  
  14474. * champ de deplacement des points interceptes
  14475. dxmp1 = (NOMC UX dxmp1 NATURE DIFFUS) * (-1.) ;
  14476. dymp1 = (NOMC UY dymp1 NATURE DIFFUS) * (-1.) ;
  14477. dzmp1 = (NOMC UZ dzmp1 NATURE DIFFUS) * (-1.) ;
  14478. depmp1 = dxmp1 et dymp1 et dzmp1 ;
  14479.  
  14480. si ((nbno nointer1) > 0) ;
  14481. * on peut avoit tout intersecte auquel cas on n a pas a mettre le
  14482. * pas pour les autres
  14483. chdist1 = redu chpas0 nointer1 ;
  14484. chdist1 = chan 'ATTRIBUT' chdist1 nature diffus ;
  14485. chdist8 = chdist1 et chdmp1 ;
  14486. chfn1 = redu chfn0 nointer1 ;
  14487. chfn1 = chan 'ATTRIBUT' chfn1 nature diffus ;
  14488. chfn8 = chfn1 et finter1r ;
  14489. sinon ;
  14490. chdist8 = chdmp1 ;
  14491. chfn8 = finter1r ;
  14492. finsi ;
  14493. sinon ;
  14494. chdist8 = chpas0 ;
  14495. chfn8 = chfn0 ;
  14496. dxmp1 = (NOMC UX ((exco X CH_OLD2) * 0.) NATURE DIFFUS) ;
  14497. dymp1 = (NOMC UY ((exco Y CH_OLD2) * 0.) NATURE DIFFUS) ;
  14498. dzmp1 = (NOMC UZ ((exco Z CH_OLD2) * 0.) NATURE DIFFUS) ;
  14499. depmp1 = dxmp1 et dymp1 et dzmp1 ;
  14500. finsi ;
  14501.  
  14502. chdist9 = chan 'ATTRIBUT' chdist8 nature discret ;
  14503. chfn9 = chan 'ATTRIBUT' chfn8 nature discret ;
  14504.  
  14505. *MESS '---------------------------------> exiting @INTSEC';
  14506.  
  14507. FINPROC chdist9 minter1 chfn9 depmp1;
  14508.  
  14509. **** IPOE
  14510. DEBPROC IPOE OBJ_11/FLOTTANT OBJ_12/LISTREEL OBJ_13/CHPOINT EVO_1*EVOLUTION MO_1/MOT ;
  14511. MESS '>>>>IPOE 30/4/96 Please call now @IPOE ';
  14512. 'FINPROC' ;
  14513. **** @IPOE
  14514. DEBPROC @IPOE OBJ_11/FLOTTANT OBJ_12/LISTREEL OBJ_13/CHPOINT EVO_1*EVOLUTION MO_1/MOT ;
  14515. *********************************************************
  14516. ****** PROCEDURE @IPOE ******
  14517. *********************************************************
  14518. * INTERPOLATION EN UTILISANT UNE EVOLUTION
  14519. *--------------------------------------------------------
  14520. *23456789012345678901234567890123456789012345678901234567890123456789012
  14521. * 1 2 3 4 5 6 7
  14522. LRE_1 = EXTR EVO_1 'ABSC' 1 ;
  14523. LRE_2 = EXTR EVO_1 'ORDO' 1 ;
  14524. SI ( NON (EXISTE MO_1)) ;
  14525. MO_2 = MOT 'SANS' ;
  14526. SINON ;
  14527. MO_2 = MO_1 ;
  14528. FINSI ;
  14529. SI (( EGA MO_2 'LINE' ) OU ( EGA MO_2 'FIXE' )) ;
  14530. SI ( EXISTE OBJ_11 ) ;
  14531. OBJ_2 = @ITPLT LRE_1 LRE_2 MO_2 OBJ_11 ;
  14532. FINSI ;
  14533. SI ( EXISTE OBJ_12 ) ;
  14534. OBJ_2 = @ITPLT LRE_1 LRE_2 MO_2 OBJ_12 ;
  14535. FINSI ;
  14536. SI ( EXISTE OBJ_13 ) ;
  14537. OBJ_2 = @ITPLT LRE_1 LRE_2 MO_2 OBJ_13 ;
  14538. FINSI ;
  14539. SINON ;
  14540. SI ( EXISTE OBJ_11 ) ;
  14541. OBJ_2 = IPOL OBJ_11 LRE_1 LRE_2 ;
  14542. FINSI ;
  14543. SI ( EXISTE OBJ_12 ) ;
  14544. OBJ_2 = IPOL OBJ_12 LRE_1 LRE_2 ;
  14545. FINSI ;
  14546. SI ( EXISTE OBJ_13 ) ;
  14547. OBJ_2 = IPOL OBJ_13 LRE_1 LRE_2 ;
  14548. FINSI ;
  14549. FINSI ;
  14550. FINPROC OBJ_2 ;
  14551. **** @ITPLT
  14552.  
  14553. DEBPROC @ITPLT LR_1*LISTREEL LR_2*LISTREEL MO_1*MOT OBJ_11/FLOTTANT OBJ_12/LISTREEL OBJ_13/CHPOINT ;
  14554.  
  14555. *23456789012345678901234567890123456789012345678901234567890123456789012
  14556. * 1 2 3 4 5 6 7
  14557.  
  14558. *********************************************************
  14559. ****** PROCEDURE @ITPLT ******
  14560. ********************************************************************
  14561. * INTERPOLATION A PARTIR DE 2 LISTREELS AVEC EXTRAPOLATION POSSIBLE
  14562. *-------------------------------------------------------------------
  14563.  
  14564. SI ( NON (( EGA MO_1 'LINE') OU ( EGA MO_1 'FIXE')) ) ;
  14565. MESS '>>>@ITPLT>>> ON VOULAIT LE MOT LINE OU FIXE' ;
  14566. MESS '>>>@ITPLT>>> ON NE FAIT RIEN' ;
  14567. ERREUR 2 ;
  14568. FINSI ;
  14569. SI ( EXISTE OBJ_11 ) ;
  14570. OBJ_1 = OBJ_11 ;
  14571. VMA_1 = OBJ_1 ;
  14572. VMI_1 = OBJ_1 ;
  14573. FINSI ;
  14574. SI ( EXISTE OBJ_12 ) ;
  14575. OBJ_1 = OBJ_12 ;
  14576. VMA_1 = MAXI OBJ_1 ;
  14577. VMI_1 = MINI OBJ_1 ;
  14578. FINSI ;
  14579. SI ( EXISTE OBJ_13 ) ;
  14580. OBJ_1 = OBJ_13 ;
  14581. VMA_1 = MAXI OBJ_1 ;
  14582. VMI_1 = MINI OBJ_1 ;
  14583. FINSI ;
  14584.  
  14585. SI (( VMA_1 < ( MAXI LR_1)) ET ( VMI_1 > ( MINI LR_1)) ) ;
  14586. OBJ_2 = IPOL OBJ_1 LR_1 LR_2 ;
  14587. SINON ;
  14588. LRE_1 = LR_1 ;
  14589. LRE_2 = LR_2 ;
  14590. DVAL = ( MAXI ( ABS LR_1 ) ) / 100. ;
  14591. SI ( NON ( VMA_1 < ( MAXI LR_1)) ) ;
  14592. N1 = DIME LR_1 ;
  14593. VX_F = EXTR LR_1 N1 ;
  14594. VX_F1 = EXTR LR_1 ( N1 - 1 ) ;
  14595. VY_F = EXTR LR_2 N1 ;
  14596. VY_F1 = EXTR LR_2 ( N1 - 1 ) ;
  14597. VX_1 = VMA_1 + DVAL ;
  14598. SI (EGA MO_1 'LINE' ) ;
  14599. VY_1 = VY_F + ((VY_F - VY_F1) * (VX_1 - VX_F)/(VX_F - VX_F1)) ;
  14600. SINON ;
  14601. VY_1 = VY_F ;
  14602. FINSI ;
  14603. LRE_1 = LRE_1 ET ( PROG VX_1 ) ;
  14604. LRE_2 = LRE_2 ET ( PROG VY_1 ) ;
  14605. * MESS '>>1 VAL XMAX YMAX XEXT YEXT' VMA_1 VX_F VY_F VX_1 VY_1 ;
  14606. FINSI ;
  14607. SI ( NON ( VMI_1 > ( MINI LR_1)) ) ;
  14608. VX_I = EXTR LR_1 1 ;
  14609. VX_I1 = EXTR LR_1 2 ;
  14610. VY_I = EXTR LR_2 1 ;
  14611. VY_I1 = EXTR LR_2 2 ;
  14612. VX_1 = VMI_1 - DVAL ;
  14613. SI (EGA MO_1 'LINE' ) ;
  14614. VY_1 = VY_I + ((VY_I - VY_I1) * (VX_1 - VX_I)/(VX_I - VX_I1)) ;
  14615. SINON ;
  14616. VY_1 = VY_I ;
  14617. FINSI ;
  14618. LRE_1 = ( PROG VX_1 ) ET LRE_1 ;
  14619. LRE_2 = ( PROG VY_1 ) ET LRE_2 ;
  14620. * MESS '>>>@ITPLT>>> extrapolation VAL XMIN YMIN XEXT YEXT';
  14621. * MESS VMI_1 VX_I VY_I VX_1 VY_1 ;
  14622. FINSI ;
  14623. OBJ_2 = IPOL OBJ_1 LRE_1 LRE_2 ;
  14624. FINSI ;
  14625.  
  14626. FINPROC OBJ_2 ;
  14627. **** @LECTB
  14628.  
  14629. DEBPROC @LECTB TAB1*TABLE ;
  14630. *
  14631. ***********************************************************
  14632. * Procedure de lecture de la carte de champ magnetique *
  14633. * et de dpsi dans un fichier issu de PROTEUS. *
  14634. * Alain MOAL (Fevrier 2001) *
  14635. ***********************************************************
  14636. * Modif : *
  14637. * 08/11/01 (A.MOAL) : lecture et carte de dpsi *
  14638. ***********************************************************
  14639. *
  14640. MESS '---------------------------------> calling @LECTB';
  14641. *
  14642. *--------------- VARIABLES D'ENTREE :
  14643. NOM0 = TAB1.<NOM_FICHIER_B ;
  14644. ANG0 = TAB1.<EXTENSION_TORO ;
  14645. NBE0 = TAB1.<NBELEM_TORO ;
  14646. CT0 = TAB1.<CENTRE_TORE ;
  14647. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  14648. *------------------------------------
  14649. *
  14650. OPTI ACQUERIR NOM0 ;
  14651. *---- lecture du nombre de lignes a lire dans le fichier
  14652. ACQU NBR1*ENTIER NBZ1*ENTIER FLREF1*FLOTTANT FLREF2*FLOTTANT ;
  14653. I = NBR1 * NBZ1 ;
  14654. MESS '@LECTB IS READING 'I' LINES IN FILE 'NOM0 ;
  14655. MESS 'NODES NUMBER (DIRECTION R) : 'NBR1 ;
  14656. MESS 'NODES NUMBER (DIRECTION Z) : 'NBZ1 ;
  14657.  
  14658. I = NBR1 * NBZ1 ;
  14659. *
  14660. ACQU R0*FLOTTANT Z0*FLOTTANT FLUX1*FLOTTANT BR1*FLOTTANT BZ1*FLOTTANT BTOR1*FLOTTANT DPSI1*FLOTTANT;
  14661. *
  14662. *---- creation du premier point support du champ
  14663. *---- tourne de 1 degre pour etre sur d'envelopper
  14664. *---- le domaine d'etude
  14665. P0 = (R0 0. Z0) TOUR (-1.) CT0 CT1 ;
  14666. *
  14667. *---- creation du chpoint s'appuyant sur ce point
  14668. CHPT = MANU CHPO P0 5 'FLUX' FLUX1 'BR' BR1 'BZ' BZ1 'BPHI' BTOR1 'DPSI' DPSI1 'NATURE' DISCRET ;
  14669. *
  14670. *---- boucle sur les points dans la direction toroidale
  14671. J = 0 ;
  14672. REPETER BOUC0 NBE0 ;
  14673. J = J + 1 ;
  14674. P01 = P0 TOUR ((ANG0+2.+1.e-2) * J / NBE0) CT0 CT1 ;
  14675. CHP01 = MANU CHPO P01 5 'FLUX' FLUX1 'BR' BR1 'BZ' BZ1 'BPHI' BTOR1 'DPSI' DPSI1 'NATURE' DISCRET ;
  14676. CHPT = CHPT ET CHP01 ;
  14677. FIN BOUC0 ;
  14678. *
  14679. *---- boucle sur les I-1 autres lignes du tableau
  14680. REPETER BOUC1 (I-1) ;
  14681. ACQU R1*FLOTTANT Z1*FLOTTANT FLUX1*FLOTTANT BR1*FLOTTANT BZ1*FLOTTANT BTOR1*FLOTTANT DPSI1*FLOTTANT;
  14682. P1 =( R1 0. Z1) TOUR (-1.) CT0 CT1 ;
  14683. CHP1 = MANU CHPO P1 5 'FLUX' FLUX1 'BR' BR1 'BZ' BZ1 'BPHI' BTOR1 'DPSI' DPSI1 'NATURE' DISCRET ;
  14684. CHPT = CHPT ET CHP1 ;
  14685. J = 0 ;
  14686. REPETER BOUC2 NBE0 ;
  14687. J = J + 1 ;
  14688. P11 = P1 TOUR ((ANG0+2.+1.e-2) * J / NBE0) CT0 CT1 ;
  14689. CHP11 = MANU CHPO P11 5 'FLUX' FLUX1 'BR' BR1 'BZ' BZ1 'BPHI' BTOR1 'DPSI' DPSI1 'NATURE' DISCRET ;
  14690. CHPT = CHPT ET CHP11 ;
  14691. FIN BOUC2 ;
  14692. FIN BOUC1 ;
  14693.  
  14694. MAIL1 = EXTR CHPT 'MAIL' ;
  14695. VECB = VECT CHPT 0.03 'BR' 'BZ' ROUGE ;
  14696. *
  14697. *---- projection sur un maillage
  14698. P0 = (R0 0. Z0) TOUR (-1.) CT0 CT1 ;
  14699. P1 = (R1 0. Z1) TOUR (-1.) CT0 CT1 ;
  14700. P01 = (R0 0. Z1) TOUR (-1.) CT0 CT1 ;
  14701. P10 = (R1 0. Z0) TOUR (-1.) CT0 CT1 ;
  14702. L1 = P0 D (NBR1-1) P10 ;
  14703. L2 = P10 D (NBZ1-1) P1 ;
  14704. L3 = P1 D (NBR1-1) P01 ;
  14705. L4 = P01 D (NBZ1-1) P0 ;
  14706. S1 = (DALLER L1 L2 L3 L4 PLAN) COUL BLEU ;
  14707. VOL1 = S1 VOLU ROTA NBE0 (ANG0+2.) CT0 CT1 ;
  14708. *
  14709. *---- critere d'elimination inferieur a la taille de maille
  14710. *---- dans le plan (R,Z)
  14711. DIST1 = (MESU L1) / (5. * (NBR1-1)) ;
  14712. DIST2 = (MESU L4) / (5. * (NBZ1-1)) ;
  14713. SI (DIST1 >EG DIST2) ;
  14714. DIST0 = DIST2 ;
  14715. SINON ;
  14716. DIST0 = DIST1 ;
  14717. FINSI ;
  14718. ELIM DIST0 (VOL1 ET MAIL1) ;
  14719. *TITRE ' ';
  14720. *TRAC (VOL1 ET MAIL1) ;
  14721. *
  14722. *---- trace pour verification
  14723. CHPFLU = EXCO 'FLUX' CHPT ;
  14724. TITRE 'MAGNETIC FLUX' ;
  14725. TRAC 30 CHPFLU VOL1 ;
  14726. CHDPSI = EXCO 'DPSI' CHPT ;
  14727. TITRE 'DPSI' ;
  14728. TRAC 30 CHDPSI VOL1 ;
  14729. *
  14730. *--------------- VARIABLES DE SORTIE :
  14731. TAB1.<CARTE_B = CHPT ;
  14732. TAB1.<GRILLE_B = VOL1 ;
  14733. *------------------------------------
  14734. *
  14735. MESS '---------------------------------> exiting @LECTB';
  14736. *
  14737. FINPROC ;
  14738. **** @LECTF
  14739.  
  14740. DEBPROC @LECTF TAB1*TABLE ;
  14741. *
  14742. ***********************************************************
  14743. * Procedure de lecture du flux normalise sur une ligne *
  14744. * dans un fichier issu de PROTEUS. *
  14745. * Alain MOAL (Fevrier 2001) *
  14746. ***********************************************************
  14747. *
  14748. MESS '---------------------------------> calling @LECTF';
  14749. *
  14750. *--------------- VARIABLES D'ENTREE :
  14751. NOM0 = TAB1.<NOM_FICHIER_F ;
  14752. ANG0 = TAB1.<EXTENSION_TORO ;
  14753. NBE0 = TAB1.<NBELEM_TORO ;
  14754. CT0 = TAB1.<CENTRE_TORE ;
  14755. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  14756. *------------------------------------
  14757. *
  14758. OPTI ACQUERIR NOM0 ;
  14759. *---- lecture du nombre de lignes a lire dans le fichier
  14760. ACQU I*ENTIER ;
  14761. MESS '@LECTF IS READING 'I' LINES IN FILE 'NOM0 ;
  14762. *
  14763. *---- ligne de titre
  14764. ACQU MOT1*MOT MOT2*MOT MOT3*MOT MOT4*MOT MOT5*MOT MOT6*MOT MOT7*MOT ;
  14765. *
  14766. ACQU R0*FLOTTANT Z0*FLOTTANT DPSI1*FLOTTANT AEFF10*FLOTTANT DDPSI1*FLOTTANT PLEG1*FLOTTANT Q1*FLOTTANT ;
  14767. *
  14768. *---- creation du premier point support du champ
  14769. *---- tourne de 1 degre pour etre sur d'envelopper
  14770. *---- le domaine d'etude
  14771. P0 = (R0 0. Z0) TOUR (-1.) CT0 CT1 ;
  14772. *
  14773. *---- creation du chpoint s'appuyant sur ce point
  14774. FLUN0 = MANU CHPO P0 1 SCAL Q1 NATURE DISCRET ;
  14775. *
  14776. *---- boucle sur les points dans la direction toroidale
  14777. J = 0 ;
  14778. REPETER BOUC0 NBE0 ;
  14779. J = J + 1 ;
  14780. P01 = P0 TOUR ((ANG0+2.+1.e-2) * J / NBE0) CT0 CT1 ;
  14781. CHP01 = MANU CHPO P01 1 SCAL Q1 NATURE DISCRET ;
  14782. FLUN0 = FLUN0 ET CHP01 ;
  14783. FIN BOUC0 ;
  14784. *
  14785. *---- boucle sur les I-1 autres lignes du tableau
  14786. REPETER BOUC1 (I-1) ;
  14787. ACQU R1*FLOTTANT Z1*FLOTTANT DPSI1*FLOTTANT AEFF10*FLOTTANT DDPSI1*FLOTTANT PLEG1*FLOTTANT Q1*FLOTTANT ;
  14788. P1 =( R1 0. Z1) TOUR (-1.) CT0 CT1 ;
  14789. CHP1 = MANU CHPO P1 1 SCAL Q1 NATURE DISCRET ;
  14790. FLUN0 = FLUN0 ET CHP1 ;
  14791. J = 0 ;
  14792. REPETER BOUC2 NBE0 ;
  14793. J = J + 1 ;
  14794. P11 = P1 TOUR ((ANG0+2.+1.e-2) * J / NBE0) CT0 CT1 ;
  14795. CHP11 = MANU CHPO P11 1 SCAL Q1 NATURE DISCRET ;
  14796. FLUN0 = FLUN0 ET CHP11 ;
  14797. FIN BOUC2 ;
  14798. FIN BOUC1 ;
  14799. MAIL1 = EXTR FLUN0 'MAIL' ;
  14800. *
  14801. *---- projection sur un maillage
  14802. L1 = P0 D (I-1) P1 ;
  14803. S1 = L1 ROTA NBE0 (ANG0+2.) CT0 CT1 ;
  14804. *
  14805. *---- critere d'elimination inferieur a la taille de maille
  14806. *---- dans le plan (R,Z)
  14807. DIST1 = (MESU L1) / (5. * (I-1)) ;
  14808. ELIM DIST1 (S1 ET MAIL1) ;
  14809. *
  14810. *---- trace pour verification
  14811. TITRE 'NORMALISED FLUX' ;
  14812. EVOL1 = EVOL ROUG CHPO (REDU FLUN0 L1) L1 ;
  14813. DESS EVOL1 ;
  14814. TRAC 30 FLUN0 S1 ;
  14815. *
  14816. *--------------- VARIABLES DE SORTIE :
  14817. TAB1.<FLUX_NORMALISE = FLUN0 ;
  14818. TAB1.<MAILLAGE_FN = S1 ;
  14819. *------------------------------------
  14820. *
  14821. MESS '---------------------------------> exiting @LECTF';
  14822. *
  14823. FINPROC ;
  14824. **** @LISTMM
  14825. DEBPROC @LISTMM CHAM1/MCHAML CHP1/CHPOINT;
  14826.  
  14827. SI (EXISTE CHAM1);
  14828. CH1 = CHAM1 ;
  14829. SINON;
  14830. SI (EXISTE CHP1);
  14831. CH1 = CHP1;
  14832. SINON ;
  14833. ERRE 'IL MANQUE LE CHAMPS';
  14834. FINSI ;
  14835. FINSI ;
  14836. MESS ' ';
  14837.  
  14838. DD1 = DIME (EXTR CH1 COMP);
  14839. SI (DD1 > 1 );
  14840. MESS 'BEWARE ! the field has more than one component';
  14841. FINSI ;
  14842.  
  14843. MIN1 = MINI CH1;
  14844. MAX1 = MAXI CH1;
  14845. PRE1 = ' ';
  14846. MES1 = CHAIN PRE1 'mini ' MIN1 ' maxi ' MAX1;
  14847. MESS MES1;
  14848. FINPROC ;
  14849. **** LUMIN
  14850. * @LUMIN LINC2 PENDO1 TAB1 PHIENDO ;
  14851. *>LINC2 = LINC2; >POI1=PENDO1 ;>PHI1=PHIENDO;
  14852. DEBPROC @LUMIN >LINC2*MAILLAGE >POI1/POINT TAB1*TABLE >PHI1/FLOTTANT;
  14853. MESS '>>>>>> DEBUT @LUMIN >>>>>>>PHI=' >PHI1;
  14854. TEMP1 = NOMC SCAL TAB1.TEMPERATURE ;
  14855. *CHX1 = COOR 1 TAB1.LFLUX_EXTE_DESS;
  14856. *EVTEMX = EVOL BLEU CHPO CHX1 SCAL TAB1.LFLUX_EXTE_DESS;
  14857. *DESS EVTEMX ;
  14858. *LIX1 = EXTR EVTEMX 'ORDO' ;
  14859. *LIT1 = EXTR EVTEMI 'ORDO' ;
  14860. *EVTXI = EVOL MANU LIX1 LIT1 ;
  14861. *DESS EVTXI;
  14862. >X3 = REDU TAB1.C_COTETF1 >LINC2 ;
  14863. >Y3 = REDU TAB1.C_SITETF1 >LINC2 ;
  14864. T3 = ATG >Y3 >X3 ;
  14865. TITRE ' angle des normales a la ligne';
  14866. EV3 = EVOL CHPO T3 >LINC2 ;
  14867. DESS EV3;
  14868. >Z3 = 0. ;
  14869. * SINL1 = REDU TAB1.C_SITETF1 >LINC2;
  14870. * CHPX = EXCO SCAL ( 1. * ( COTETF1 ) ) UX ;
  14871. * CHPY = EXCO SCAL ( 1. * ( SITETF1 ) ) UY ;
  14872. * CHPT = (@ET CHPX CHPY );
  14873. * VEC22 = @VECADA CHPT ( 1. * 0.01 ) 'ROUGE' ;
  14874. * TRAC 'CACH' TAB1.NISOV TEMP1 SAIG1 VEC22 (CONT SAIG1);
  14875. SI( EXISTE >POI1) ;
  14876. >X11 >Y1 = COOR >POI1 ;
  14877. >X2 >Y2 = COOR >LINC2;
  14878. XCT1 = COOR 1 TAB1.<CENTRE_TORE ;
  14879. >R1 = >X11 - XCT1 ;
  14880. >R0 = 2.4 ;
  14881. >PHI0 = >PHI1 - 15. ;
  14882. >X1 = >R1 * (COS >PHI1) + XCT1 ;
  14883. >X0 = >R0 * (COS >PHI0) + XCT1 ;
  14884. DX0 = >X2 - >X0 ;
  14885. DZ0 = (>Y2 * 0. ) - (( SIN >PHI0) * >R0 ) ;
  14886. * RHO est la distance entre le point courant et le centre du champ
  14887. RHO = ((DX0 ** 2) + (DZ0 ** 2)) ** 0.5 ;
  14888. * RHO0 est la distance maximale entre un point courant et le centre du champ
  14889. RHO0 = 0.69 ;
  14890. * Lint est la longueur d'integration au niveau du point courant
  14891. Lint =(( RHO * RHO * 0.14 / RHO0/RHO0) + 1.) * 4.77E-3 ;
  14892. TITRE 'Pas d integration avant correction' >PHI1 ;
  14893. EVLint = EVOL ROUG CHPO Lint SCAL TAB1.LFLUX_EXTE_DESS;
  14894. DESS EVLint ;
  14895.  
  14896. * ETEND est l'etendue geometrique normalisee a 1 au centre du champ
  14897. ETEND= RHO * RHO / RHO0 / RHO0 * -0.1 + 1. ;
  14898. TITRE 'etendue geometrique normalisee' >PHI1;
  14899. EVEG = EVOL ROUG CHPO ETEND SCAL TAB1.LFLUX_EXTE_DESS;
  14900. DESS EVEG ;
  14901.  
  14902. DX1 = >X2 - >X1 ;
  14903. DY1 = >Y2 - >Y1 ;
  14904. DZ1 = (>Y2 * 0. ) - (( SIN >PHI1) * ( >X11 - XCT1)) ;
  14905. TITRE ' DZ1 en tout point de la ligne ';
  14906. EV5 = EVOL CHPO DZ1 >LINC2 ;
  14907. * DESS EV5;
  14908. TITRE ' DX1 en tout point de la ligne ';
  14909. EV5 = EVOL CHPO DX1 >LINC2 ;
  14910. * DESS EV5;
  14911. NDX = ((DX1 ** 2) + (DY1 ** 2) + (DZ1 ** 2)) ** 0.5 ;
  14912. DX1 = DX1 / NDX;
  14913. DY1 = DY1 / NDX;
  14914. DZ1 = DZ1 / NDX;
  14915. COSL1 = ( (((DY1 * >Z3) - (DZ1 * >Y3)) ** 2 ) + (((DZ1 * >X3) - (DX1 * >Z3)) ** 2 ) + (((DX1 * >Y3) - (DY1 * >X3)) ** 2 )) ** 0.5 ;
  14916. SINL1 = (((COSL1 ** 2) * -1.) + 1.) ** 0.5 ;
  14917. ANGL1 = ATG COSL1 SINL1;
  14918. TITRE ' angle normales - point endoscope ' >PHI1;
  14919. EV3 = EVOL CHPO ANGL1 >LINC2 ;
  14920. DESS EV3;
  14921. * Le COSL1 est la pour tenir compte du fait que la resolution spatiale donnee
  14922. * par MIGOZZI est une resolution perpendiculaire a l'axe optique (que l'on
  14923. * projette sur l'aiguille.
  14924. Lint = Lint / (COS ANGL1) ;
  14925. TITRE '1/cos de l angle' >PHI1 ;
  14926. EV3 = EVOL CHPO ((COS ANGL1)**-1) >LINC2 ;
  14927. DESS EV3;
  14928. TITRE 'Pas d integration apres correction' >PHI1;
  14929. EV3 = EVOL CHPO Lint >LINC2 ;
  14930. DESS EV3;
  14931. FINSI ;
  14932. EMISSIV1 = 1.;
  14933. PLANKC1 = 3.74E-16 ;
  14934. PLANKC2 = 1.44E-2 ;
  14935. PLANKL = 4.E-6 ;
  14936. PLANKLM5 = PLANKL ** -5 ;
  14937. PI = 3.14159 ;
  14938. TEMP2 = REDU TEMP1 >LINC2;
  14939. LUMI1 = ( ((( EXP ((( TEMP2 * PLANKL) ** -1 ) * PLANKC2)) - 1.) * PI) ** -1 ) * EMISSIV1 * PLANKC1 * PLANKLM5 ;
  14940. * LUMI2 = LUMI1 * SINL1 ;
  14941. LUMI2 = LUMI1 * ETEND ;
  14942. EVTEML1 = EVOL ROUG CHPO LUMI1 SCAL >LINC2;
  14943. EVTEML2 = EVOL VERT CHPO LUMI2 SCAL >LINC2;
  14944. TAB3 = TABLE ;
  14945. TAB3.1 = 'MARQ CROI REGU MOT TITR LUMINES' ;
  14946. TAB3.2 = 'MARQ TRIA REGU MOT TITR LUMI*EG' ;
  14947. TAB3.3 = 'MARQ CARR REGU MOT TITR INTGLUMI' ;
  14948. * DESS (EVTEML1 ET EVTEML2) MIMA LEGE TAB3 ;
  14949. CHX1 = COOR 1 >LINC2;
  14950. EVTEMX = EVOL BLEU CHPO CHX1 SCAL >LINC2;
  14951. LIX1 = EXTR EVTEMX 'ORDO' ;
  14952. LIL1 = EXTR EVTEML1 'ORDO' ;
  14953. LIL2 = EXTR EVTEML2 'ORDO' ;
  14954. EVLXI1 = EVOL ROUG MANU LIX1 LIL1 ;
  14955. EVLXI2 = EVOL VERT MANU LIX1 LIL2 ;
  14956. * DESS (EVLXI1 ET EVLXI2) MIMA LEGE TAB3;
  14957. IL = 0 ;
  14958. REPETER BLUMI (NBNO >LINC2) ;
  14959. IL = IL + 1;
  14960. >PL1 = >LINC2 POINT IL ;
  14961. XL1 = COOR 1 >PL1 ;
  14962. XLINC2 = COOR 1 >LINC2 ;
  14963. >PASL = Lint EXTR 'SCAL' >PL1 ;
  14964. XLINF = XL1 - (>PASL / 2.) ;
  14965. XLSUP = XL1 + (>PASL / 2.);
  14966. MASL1 = MASQUE XLINC2 EGINFE XLSUP ;
  14967. MASL2 = MASQUE XLINC2 EGSUPE XLINF;
  14968. MASLT = MASL1 * MASL2;
  14969. LUMI3 = LUMI2 * MASLT ;
  14970. EVTEML3 = EVOL ROSE CHPO LUMI3 SCAL >LINC2;
  14971. LIL3 = EXTR EVTEML3 'ORDO' ;
  14972. EVLXI3 = EVOL ROUG MANU LIX1 LIL3;
  14973. * DESS (EVLXI3 ) ;
  14974. IRR = 0;
  14975. LIL3B = LIL3 ;
  14976. LIX1B = LIX1;
  14977. SI ( XLINF >EG (MINI LIX1)) ;
  14978. IRANGI1 = ( LIX1 MASQUE INFERIEUR SOMME XLINF) + 1;
  14979. IRANGI2 = IRANGI1 + 1;
  14980. VINF = @ITPLT LIX1 LIL2 'FIXE' XLINF ;
  14981. LIL3B = INSE LIL3B IRANGI1 0. ;
  14982. LIL3B = INSE LIL3B IRANGI2 VINF ;
  14983. LIX1B = INSE LIX1 IRANGI1 (XLINF - 1.E-6) ;
  14984. LIX1B = INSE LIX1B IRANGI2 XLINF;
  14985. IRR = 2;
  14986. FINSI;
  14987. SI ( XLSUP &lt;EG (MAXI LIX1)) ;
  14988. IRANGS1 = (MASQUE LIX1 INFERIEUR SOMME XLSUP) + 1 + IRR;
  14989. IRANGS2 = IRANGS1 + 1;
  14990. VSUP = @ITPLT LIX1 LIL2 'FIXE' XLSUP ;
  14991. LIL3B = INSE LIL3B IRANGS1 VSUP ;
  14992. LIL3B = INSE LIL3B IRANGS2 0 ;
  14993. LIX1B = INSE LIX1B IRANGS1 XLSUP ;
  14994. LIX1B = INSE LIX1B IRANGS2 (XLSUP + 1.E-6) ;
  14995. FINSI;
  14996. EVLXI3B = EVOL BLEU MANU LIX1B LIL3B;
  14997. * DESS (EVLXI3 ET EVLXI3B) ;
  14998. MOYLU3 = (INTG EVLXI3B) / >PASL ;
  14999. SI ( IL EGA 1 ) ;
  15000. CHPM3 = MANU CHPO >PL1 1 'SCAL' MOYLU3 NATURE DISCRET ;
  15001. SINON ;
  15002. CHPM3 =CHPM3 ET (MANU CHPO >PL1 1 'SCAL' MOYLU3 NATURE DISCRET) ;
  15003. FINSI;
  15004. FIN BLUMI ;
  15005. EVTEML4 = EVOL ROSE CHPO CHPM3 SCAL >LINC2;
  15006. LIL4 = EXTR EVTEML4 'ORDO' ;
  15007. EVLXI4 = EVOL ROSE MANU LIX1 LIL4 ;
  15008. TITRE ' Luminescence' >PHI1 ;
  15009. DESS (EVLXI1 ET EVLXI2 ET EVLXI4 ) MIMA LEGE TAB3 ;
  15010. CHT4 = (((LOG (((CHPM3 * PI) ** -1) * EMISSIV1 * PLANKC1 * PLANKLM5 + 1.)) * PLANKL) ** -1) * PLANKC2 ;
  15011. TEMP4 = REDU CHT4 >LINC2;
  15012. EVTE2 = EVOL VERT CHPO TEMP2 SCAL >LINC2;
  15013. EVTE4 = EVOL ROUG CHPO TEMP4 SCAL >LINC2;
  15014. LTE2 = EXTR EVTE2 'ORDO' ;
  15015. LTE4 = EXTR EVTE4 'ORDO' ;
  15016. TITRE ' Temperatures mesurees' ;
  15017. TAB1.EVLL4 = EVOL ROUG MANU LIX1 LTE4 ;
  15018. TITRE ' Temperatures initiales' ;
  15019. TAB1.EVLL2 = EVOL VERT MANU LIX1 LTE2 ;
  15020. TAB1.ANGLUMI = ANGL1 ;
  15021. MESS '>>>>>> FIN @LUMIN >>>>>>>>>>' ;
  15022. FINPROC ;
  15023.  
  15024.  
  15025. **** @MAGNB
  15026.  
  15027. DEBPROC @MAGNB TAB1*TABLE ;
  15028.  
  15029. ***********************************************************
  15030. * Procedure de calcul du champ magnetique en chaque point *
  15031. * d'un maillage donne. Alain MOAL (Fevrier 2001) *
  15032. ***********************************************************
  15033. *
  15034. MESS '---------------------------------> calling @MAGNB';
  15035. *
  15036. *--------------- VARIABLES D'ENTREE :
  15037. CHB0 = TAB1.<CARTE_B ;
  15038. GRILB0 = TAB1.<GRILLE_B ;
  15039. MAIL1 = TAB1.<MAILLAGE_B ;
  15040. *------------------------------------
  15041. *TRAC (MAIL1 ET GRILB0) ;
  15042. CHEL1 = CHAN CHAM CHB0 GRILB0 ;
  15043. CHPO1 = PROI MAIL1 CHEL1 1.E-4;
  15044. BR = EXCO 'BR' CHPO1 ;
  15045. BZ = EXCO 'BZ' CHPO1 ;
  15046. BPHI = EXCO 'BPHI' CHPO1 ;
  15047. *
  15048. MESS '---------------------------------> exiting @MAGNB';
  15049. FINPROC BR BZ BPHI ;
  15050.  
  15051. 'DEBPROC' MATHPLAS TABTEM*'TABLE' TEPMAT*'TABLE' ;
  15052. *-----------------------------------------------------------------*
  15053. * *
  15054. * M A T H P L A S *
  15055. * --------------- *
  15056. * *
  15057. * Construction des champs d{finissant un mat{riau pour un *
  15058. * calcul thermoplastique. Pour chaque {l{ment, les valeurs *
  15059. * des coefficients YOUN, NU, RHO, ALPH ainsi que la courbe *
  15060. * de traction seront {tablis en fonction de la carte de *
  15061. * temp{rature et du r{seau de courbes de traction. *
  15062. * *
  15063. * En entr{e : *
  15064. * *
  15065. * TABTEM Table contenant : *
  15066. * indice 'NCHAMP' nombre de champs thermiques (ENTIER) *
  15067. * indice i carte de temp{rature @ l'instant n›i *
  15068. * (CHPOINT) *
  15069. * indice 'PALIER' option : n› du champ @ partir duquel *
  15070. * il y a un palier dans le chargement *
  15071. * et reste inchang{ apr}s (ENTIER) *
  15072. * TEPMAT Table contenant : *
  15073. * indice 'MAILLAGE' le maillage de la structure *
  15074. * indice 'NBPTRAC' le nombre de points contenus dans *
  15075. * les courbes de traction (ENTIER) *
  15076. * indice 'DEFO' la table TABEPS contenant : *
  15077. * indice i les abscisses de la i-}me normale *
  15078. * aux courbes de traction (LISTREEL) *
  15079. * indice 'CONT' la table TABSIG contenant : *
  15080. * indice i les ordonn{es de la i-}me normale *
  15081. * aux courbes de traction (LISTREEL) *
  15082. * Remarque : i varie entre 1 et NBPTRAC *
  15083. * indice 'LISTEMP' liste des temp{ratures correspondant *
  15084. * aux courbes de traction (LISTREEL) *
  15085. * indice 'EVOALPH' ALPHA(T) (EVOLUTION) ou *
  15086. * indice 'VALALPH' ALPHA (REEL) *
  15087. * indice 'EVONU' NU(T) (EVOLUTION) ou *
  15088. * indice 'VALNU' NU (REEL) *
  15089. * indice 'EVORHO' RHO(T) (EVOLUTION) ou *
  15090. * indice 'VALRHO' RHO (REEL) *
  15091. * Remarque : si objet EVOLUTION : 'ALPH' 'NU' ou *
  15092. * 'RHO' en abscisse et 'T' en ordonn{e *
  15093. * En sortie : *
  15094. * *
  15095. * indice 'MODELE' objet mod}le (MMODEL) *
  15096. * indice 'MATERIAU' table contenant : *
  15097. * indice i champ d{finissant le mat{riau au *
  15098. * i-}me pas de calcul (MCHAML) *
  15099. * *
  15100. * Remarques : 1) l'objet mod}le sera obligatoirement du type *
  15101. * 'MECANIQUE' 'ELASTIQUE' 'PLASTIQUE' 'ISOTROPE' 'typelem' *
  15102. * et il sera cr{{ une fois pour toutes; *
  15103. * 2) le module d'Young {tant la pente @ l'origine *
  15104. * de la courbe de traction, sa donn{e n'est pas n{cessaire. *
  15105. * *
  15106. * Denis ROBERT, le 14 f{vrier 1992. *
  15107. *-----------------------------------------------------------------*
  15108. * si IMESS = VRAI : impressions des champs d{finissant le mat{riau
  15109. IMESS = vrai ;
  15110. *
  15111. GEO1 = TEPMAT.'MAILLAGE' ;
  15112. NBPTRAC = TEPMAT.'NBPTRAC' ;
  15113. LISTEMP = TEPMAT.'LISTEMP' ;
  15114. TABEPS = TEPMAT.'DEFO' ;
  15115. TABSIG = TEPMAT.'CONT' ;
  15116. TABMAT = TABLE ;
  15117. TABMOD = TABLE ;
  15118. NTHER = TABTEM.'NCHAMP' ;
  15119. *
  15120. 'SI' ( 'EXISTE' TABTEM 'PALIER' ) ;
  15121. NTHER = TABTEM.'PALIER' ;
  15122. 'FINSI' ;
  15123. 'SI' ( 'EXISTE' TEPMAT 'VALALPH' ) ;
  15124. IALPH = 1 ; ALPIEL1 = TEPMAT.'VALALPH' ;
  15125. 'SINON' ;
  15126. IALPH = 2 ;
  15127. LISALP1 = 'EXTR' TEPMAT.'EVOALPH' 'ALPH' ;
  15128. LISTE2 = 'EXTR' TEPMAT.'EVOALPH' 'T' ;
  15129. 'FINSI' ;
  15130. 'SI' ( 'EXISTE' TEPMAT 'VALRHO' ) ;
  15131. IRHO = 1 ; RHOIEL1 = TEPMAT.'VALRHO' ;
  15132. 'SINON' ;
  15133. IRHO = 2 ;
  15134. LISRHO1 = 'EXTR' TEPMAT.'EVORHO' 'RHO' ;
  15135. LISTE3 = 'EXTR' TEPMAT.'EVORHO' 'T' ;
  15136. 'FINSI' ;
  15137. 'SI' ( 'EXISTE' TEPMAT 'VALNU' ) ;
  15138. INU = 1 ; NUIEL1 = TEPMAT.'VALNU' ;
  15139. 'SINON' ;
  15140. INU = 2 ;
  15141. LISNU1 = 'EXTR' TEPMAT.'EVONU' 'NU' ;
  15142. LISTE4 = 'EXTR' TEPMAT.'EVONU' 'T' ;
  15143. 'FINSI' ;
  15144. 'SI' ( IMESS ) ;
  15145. 'SAUTER' 1 'LIGNE' ;
  15146. 'MESS' '*** MAt{riau THermoPLAStique ***' ;
  15147. 'SAUTER' 1 'LIGNE' ;
  15148. 'FINSI' ;
  15149. *
  15150. * Types d'{l{ments-finis du maillage / Nombre de types / Nombre
  15151. * d'{l{ments d'un type
  15152. *
  15153. LESTYPS = GEO1 'ELEM' 'TYPE' ;
  15154. NBTYP1 = 'DIME' LESTYPS ;
  15155. NBTYPEL = 'NBEL' GEO1 LESTYPS ;
  15156. *
  15157. * Boucle sur les types d'{l{ments-finis
  15158. *
  15159. ITYP1 = 0 ;
  15160. 'REPETER' BOUTYPEL NBTYP1 ;
  15161. ITYP1 = ITYP1 + 1 ;
  15162. NBEL1 = 'EXTRAIRE' NBTYPEL ITYP1 ;
  15163. NOMEL1 = 'EXTRAIRE' LESTYPS ITYP1 ;
  15164. *
  15165. * Boucle sur les {l{ments du maillage
  15166. *
  15167. IEL = 0 ;
  15168. 'REPETER' BOUCELEM NBEL1 ;
  15169. IEL = IEL + 1 ;
  15170. 'SI' ( NBTYP1 '>EG' 2 ) ;
  15171. IELEM1 = GEO1 'ELEM' NOMEL1 IEL ;
  15172. 'SINON' ;
  15173. IELEM1 = GEO1 'ELEM' IEL ;
  15174. 'FINSI' ;
  15175. *
  15176. * Boucle sur la liste de champs de temp{rature
  15177. *
  15178. ITHER = 0 ;
  15179. 'REPETER' BOUCTHER NTHER ;
  15180. ITHER = ITHER + 1 ;
  15181. CHTER = TABTEM.ITHER ;
  15182. CHTEL1 = 'REDU' CHTER IELEM1 ;
  15183. TMOY = 0. ;
  15184. NNIEL1 = 'NBEL' IELEM1 ;
  15185. *
  15186. * Boucle sur les points du i-}me {l{ment
  15187. *
  15188. J1 = 0 ;
  15189. 'REPETER' BOUCPOIN NNIEL1 ;
  15190. J1 = J1 + 1 ;
  15191. POIN1 = IELEM1 'POIN' J1 ;
  15192. TEXTR = 'EXTR' CHTEL1 'T' POIN1 ;
  15193. TMOY = TMOY + TEXTR ;
  15194. 'FIN' BOUCPOIN ;
  15195. TMOY = TMOY / NNIEL1 ;
  15196. 'SI' ( IALPH 'EGA' 2 ) ;
  15197. ALPIEL1 = 'IPOL' TMOY LISTE2 LISALP1 ;
  15198. 'FINSI' ;
  15199. 'SI' ( IRHO 'EGA' 2 ) ;
  15200. RHOIEL1 = 'IPOL' TMOY LISTE3 LISRHO1 ;
  15201. 'FINSI' ;
  15202. 'SI' ( INU 'EGA' 2 ) ;
  15203. NUIEL1 = 'IPOL' TMOY LISTE4 LISNU1 ;
  15204. 'FINSI' ;
  15205. *
  15206. * Boucle sur le nombre de points des courbes de traction
  15207. *+*
  15208. IPTRAC = 0 ;
  15209. LEPSIEL1 = 'PROG' 0. ;
  15210. LSIGIEL1 = 'PROG' 0. ;
  15211. 'REPETER' BOUTRAC NBPTRAC ;
  15212. IPTRAC = IPTRAC + 1 ;
  15213. XX = 'IPOL' TMOY LISTEMP TABEPS.IPTRAC ;
  15214. YY = 'IPOL' TMOY LISTEMP TABSIG.IPTRAC ;
  15215. *
  15216. * Le module d'Young est la pente de la courbe de traction
  15217. *
  15218. 'SI' ( IPTRAC 'EGA' 1 ) ;
  15219. YOUIEL1 = YY / XX ;
  15220. 'FINSI' ;
  15221. LEPSIEL1 = LEPSIEL1 'ET' ( 'PROG' XX ) ;
  15222. LSIGIEL1 = LSIGIEL1 'ET' ( 'PROG' YY ) ;
  15223. 'FIN' BOUTRAC ;
  15224. TRAIEL0 = 'EVOL' 'MANU' 'DEFO' LEPSIEL1 'ECRO' LSIGIEL1 ;
  15225. LSIGIEL1 = LSIGIEL1 enle 1 ;
  15226. LEPSIEL1 = (LEPSIEL1 enle 1) - (LSIGIEL1 / YOUIEL1) ;
  15227. TRAIEL1 = 'EVOL' roug 'MANU' 'DEFO' LEPSIEL1 'ECRO' LSIGIEL1 ;
  15228. dess (TRAIEL0 et TRAIEL1) ;
  15229. 'SI' ( IMESS ) ;
  15230. 'MESS' '*** ELEMENT : ' IEL ' CHAMP : ' ITHER ' ***';
  15231. 'MESS' 'TMOY : ' TMOY ;
  15232. 'MESS' 'YOUNG : ' YOUIEL1 ;
  15233. 'MESS' 'ALPHA : ' ALPIEL1 ;
  15234. 'MESS' 'RHO : ' RHOIEL1 ;
  15235. 'MESS' 'NU : ' NUIEL1 ;
  15236. 'MESS' 'COURBE DE TRACTION (SIGMA / EPSILON) : ' ;
  15237. 'LISTE' LSIGIEL1 ;'LISTE' LEPSIEL1 ;
  15238. 'FINSI' ;
  15239. 'SI' ( IEL 'EGA' 1 ) ;
  15240. 'SI' ( ITHER 'EGA' 1 ) ;
  15241. MODTOT = 'MODE' IELEM1 'MECANIQUE' 'ELASTIQUE' 'PLASTIQUE' 'ISOTROPE' NOMEL1 ;
  15242. TABMAT.ITHER = 'MATE' MODTOT 'YOUN' YOUIEL1 'NU' NUIEL1 'RHO' RHOIEL1 'ALPH' ALPIEL1 'ECRO' TRAIEL1 ;
  15243. 'SINON' ;
  15244. TABMAT.ITHER = 'MATE' MODTOT 'YOUN' YOUIEL1 'NU' NUIEL1 'RHO' RHOIEL1 'ALPH' ALPIEL1 'ECRO' TRAIEL1 ;
  15245. 'FINSI' ;
  15246. 'SINON' ;
  15247. 'SI' ( ITHER 'EGA' 1 ) ;
  15248. MODIEL1 = 'MODE' IELEM1 'MECANIQUE' 'ELASTIQUE' 'PLASTIQUE' 'ISOTROPE' NOMEL1 ;
  15249. MODTOT = MODTOT 'ET' MODIEL1 ;
  15250. MATIEL1 = 'MATE' MODIEL1 'YOUN' YOUIEL1 'NU' NUIEL1 'RHO' RHOIEL1 'ALPH' ALPIEL1 'ECRO' TRAIEL1 ;
  15251. TABMAT.ITHER = TABMAT.ITHER 'ET' MATIEL1 ;
  15252. 'SINON' ;
  15253. MATIEL1 = 'MATE' MODIEL1 'YOUN' YOUIEL1 'NU' NUIEL1 'RHO' RHOIEL1 'ALPH' ALPIEL1 'ECRO' TRAIEL1 ;
  15254. TABMAT.ITHER = TABMAT.ITHER 'ET' MATIEL1 ;
  15255. 'FINSI' ;
  15256. 'FINSI' ;
  15257. 'FIN' BOUCTHER ;
  15258. 'FIN' BOUCELEM ;
  15259. 'FIN' BOUTYPEL ;
  15260. 'SI' ( 'EXISTE' TABTEM 'PALIER' ) ;
  15261. NTHERTOT = TABTEM.'NCHAMP' ;
  15262. INUM = NTHER ;
  15263. 'REPETER' BOUCPAL (NTHERTOT - NTHER) ;
  15264. INUM = INUM + 1 ;
  15265. TABMAT.INUM = TABMAT.NTHER ;
  15266. 'SI' ( IMESS ) ;
  15267. 'MESS' 'OPTION PALIER : CREATION DE TABMAT.' INUM ;
  15268. 'FINSI' ;
  15269. 'FIN' BOUCPAL ;
  15270. 'FINSI' ;
  15271. TEPMAT.'MODELE' = MODTOT ;
  15272. TEPMAT.'MATERIAU' = TABMAT ;
  15273. 'SI' ( IMESS ) ;
  15274. 'SAUTER' 1 'LIGNE' ;
  15275. 'MESS' '*** FIN DE MATHPLAS ***' ;
  15276. 'SAUTER' 1 'LIGNE' ;
  15277. 'FINSI' ;
  15278. *
  15279. 'FINPROC' TEPMAT ;
  15280. **** @MATLAB
  15281. DEBPROC @MATLAB EVO1*EVOLUTION ;
  15282. ABSC1 = EXTR EVO1 ABSC ;
  15283. N_COUR1 = DIME EVO1 ;
  15284. N_VALE1 = DIME ABSC1 ;
  15285.  
  15286.  
  15287.  
  15288.  
  15289. I1 = 1 ;
  15290. REPETER BOUC1 N_VALE1 ;
  15291. I2 = 1 ;
  15292. LLIST1 = EXTR ABSC1 I1 ;
  15293. REPETER BOUC2 N_COUR1 ;
  15294. VALEI2 = EXTR (EXTR EVO1 ORDO I2) I1 ;
  15295. LLIST1 = CHAIN LLIST1 ' ' VALEI2 ;
  15296. I2 = I2 + 1 ;
  15297. FIN BOUC2 ;
  15298. I1 = I1 + 1 ;
  15299. MESS LLIST1 ;
  15300. FIN BOUC1 ;
  15301.  
  15302. FINPROC ;
  15303. *-----------------------------------------------------------------------
  15304. *23456789012345678901234567890123456789012345678901234567890123456789012
  15305. * 1 2 3 4 5 6 7
  15306. *
  15307. *
  15308. *********************************************************************
  15309. * PROCEDURE FRENET3D : CALCUL DU REPERE DE FRENET LE LONG D'UNE LIGNE
  15310. * EN 3D
  15311. *********************************************************************
  15312. *
  15313. DEBPROC @FRENE3D LIG_1*MAILLAGE SURF_2/MAILLAGE VEC_1/POINT MOT_DIR/MOT LOG_1/LOGIQUE;
  15314. MESS '---------------------------------> entree dans FRENET3D';
  15315. V1 = VALEUR DIME ;
  15316. CH_T CH_N CH_B = FRENET LIG_1 ;
  15317. SI (V1 > 2) ;
  15318. A11 = EXCO 'TX' CH_T 'P11' ;
  15319. A12 = EXCO 'TY' CH_T 'P12' ;
  15320. A13 = EXCO 'TZ' CH_T 'P13' ;
  15321. A21 = EXCO 'NX' CH_N 'P21' ;
  15322. A22 = EXCO 'NY' CH_N 'P22' ;
  15323. A23 = EXCO 'NZ' CH_N 'P23' ;
  15324. A31 = EXCO 'BX' CH_B 'P31' ;
  15325. A32 = EXCO 'BY' CH_B 'P32' ;
  15326. A33 = EXCO 'BZ' CH_B 'P33' ;
  15327. CH_R = A11 ET A12 ET A13 ET A21 ET A22 ET A23 ET A31 ET A32 ET A33 ;
  15328. SI ( NON ( EXISTE LOG_1 )) ; LOG_1 = FAUX ; FINSI ;
  15329. SI LOG_1 ;
  15330. COX COY COZ = COOR LIG_1 ;
  15331. XMAX = MAXI COX ;
  15332. YMAX = MAXI COY ;
  15333. ZMAX = MAXI COZ ;
  15334. XMIN = MINI COX ;
  15335. YMIN = MINI COY ;
  15336. ZMIN = MINI COZ ;
  15337. DL = (((XMAX - XMIN)**2) + ((YMAX -YMIN)**2))**0.5 ;
  15338. AMP = DL/10. ;
  15339. VT = VECT CH_T AMP TX TY TZ ROUGE ;
  15340. VN = VECT CH_N AMP NX NY NZ VERT ;
  15341. VP = VECT CH_P AMP PX PY PZ BLEU ;
  15342. TITRE 'REPERE DE FRENET DE LA LIGNE ' ;
  15343. OEIL1 = (VEC_1 *100000.) PLUS ( 5e4 5e4 5e4 ) ;
  15344. TRAC QUAL OEIL1 (VT ET VN ET VP ) LIGN_1 ;
  15345. FINSI ;
  15346. FINSI ;
  15347. *FINPROC CH_R ;
  15348. SI (V1 &lt;EG 2) ;
  15349. A11 = EXCO 'TX' CH_T 'P11' ;
  15350. A12 = EXCO 'TY' CH_T 'P12' ;
  15351. A21 = EXCO 'NX' CH_N 'P21' ;
  15352. A22 = EXCO 'NY' CH_N 'P22' ;
  15353. CH_R = A11 ET A12 ET A21 ET A22 ;
  15354. SI LOG_1 ;
  15355. COX COY = COOR LIG_1 ;
  15356. XMAX = MAXI COX ;
  15357. YMAX = MAXI COY ;
  15358. XMIN = MINI COX ;
  15359. YMIN = MINI COY ;
  15360. DL = (((XMAX - XMIN)**2) + ((YMAX -YMIN)**2))**0.5 ;
  15361. AMP = DL/10. ;
  15362. VT = VECT CHT AMP TX TY ROUGE ;
  15363. VN = VECT CHN AMP NX NY VERT ;
  15364. TITRE 'REPERE DE FRENET DE LA LIGNE ' ;
  15365. TRAC QUAL (VT ET VN) LIGN_1 ;
  15366. FINSI ;
  15367. FINSI ;
  15368. MESS '---------------------------------> sortie de FRENET3D';
  15369. FINPROC CH_R ;
  15370.  
  15371. *-----------------------------------------------------------------------
  15372. *
  15373. *----------Fin de la procedure FRENET3D
  15374. *
  15375. *----------Debut de la procedure INDSCHL
  15376. *
  15377. *-----------------------------------------------------------------------
  15378. *23456789012345678901234567890123456789012345678901234567890123456789012
  15379. * 1 2 3 4 5 6 7
  15380. ************************************************************************
  15381. * Organisation :
  15382. * --------------
  15383. * Une boucle sur les indices de la table entree teste s'ils sont reels
  15384. * ou pas. Si l'indice est reel, on le stocke a la suite des autres
  15385. * dans la liste des reels.
  15386.  
  15387. 'DEBPROC' @INDSCHL TA_1*'TABLE ' ;
  15388. *
  15389. TA_2 = INDE TA_1 ;
  15390. P_1 = PROG ;
  15391. I1 = 0 ;
  15392. REPETER BO_1 ( DIME TA_2 ) ;
  15393. I1 = I1 + 1 ;
  15394. IND_1 = TA_2 . I1 ;
  15395. TYP_1 = TYPE IND_1 ;
  15396. SI ( EGA TYP_1 'FLOTTANT') ;
  15397. P_1 = P_1 ET ( PROG IND_1 ) ;
  15398. SINON ;
  15399. MESS '>>> TYPE DE L INDICE : ' TYP_1 'VALEUR :' IND_1 ;
  15400. MESS '>>> ON NE FAIT RIEN ' ;
  15401. FINSI ;
  15402. FIN BO_1 ;
  15403. FINPROC P_1 ;
  15404.  
  15405. *-----------------------------------------------------------------------
  15406. *
  15407. *----------Fin de la procedure @INDSCHL
  15408. *
  15409. *----------Debut de la procedure EPSCHL
  15410. *
  15411. *-----------------------------------------------------------------------
  15412. *23456789012345678901234567890123456789012345678901234567890123456789012
  15413. * 1 2 3 4 5 6 7
  15414. ************************************************************************
  15415.  
  15416. 'DEBPROC' EPSCHL MOD_1*MMODEL SI_13*MCHAML MAT_1/MCHAML TE0*CHPOINT TE1*CHPOINT TAB1/'TABLE ' ;
  15417. MESS '---------------------------------> entree dans EPSCHL';
  15418. *ENTREES TAB1.ZONE_MAT
  15419. * .MODL_MAT .TETMAT .TEXTMECA .VIEW_P
  15420. *SORTIES .MATTOT .VIEW_P
  15421. *
  15422. SI (( NON ( EXISTE MAT_1)) ET ( EXISTE TAB1)) ;
  15423. I1 = 0 ;
  15424. REPETER BOMA11 ;
  15425. I1 = I1 + 1 ;
  15426. SI ( EXISTE (TAB1.ZONE_MAT) I1 ) ;
  15427. MO1 = TAB1.MODL_MAT. I1 ;
  15428. TM_1 = ( REDU TE1 TAB1.ZONE_MAT.I1 ) ;
  15429. Y_1 = VARI TM_1 TAB1.TETMAT.MO1.YOUN YOUN ;
  15430. NU_1 = VARI TM_1 TAB1.TETMAT.MO1.NU NU ;
  15431. AL_1 = VARI TM_1 TAB1.TETMAT.MO1.ALPH ALPH ;
  15432. NU_1 = CHANGER CHAM NU_1 MO1 'RIGIDITE' ;
  15433. Y_1 = CHANGER CHAM Y_1 MO1 'RIGIDITE' ;
  15434. AL_1 = CHANGER CHAM AL_1 MO1 'RIGIDITE' ;
  15435. TEX1 = TEXTE 'YOUN Y_1 NU NU_1 ALPH AL_1' ;
  15436. IMOTM1 = DIME (MOTS TAB1.TEXTMECA.I1) ;
  15437. SI ( IMOTM1 EGA 5 ) ;
  15438. TEX1 = TEXTE TEX1 'SIGY YM_1 ' ;
  15439. TITRE 'MAT' I1 ' YIELD MODULUS' ;
  15440. YM_1 = VARI TM_1 TAB1.TETMAT.MO1.SIGY SIGY ;
  15441. YM_1 = CHANGER CHAM YM_1 MO1 'RIGIDITE' ;
  15442. TEX1 = TEXTE TEX1 'H H_1 ' ;
  15443. H_1 = VARI TM_1 TAB1.TETMAT.MO1.H H ;
  15444. H_1 = CHANGER CHAM H_1 MO1 'RIGIDITE' ;
  15445. FINSI ;
  15446. MA1 = MATE MO1 TEX1 ;
  15447. SINON ;
  15448. QUITTER BOMA11 ;
  15449. FINSI ;
  15450. SI ( I1 EGA 1 ) ;
  15451. MOD_1 = MO1 ;
  15452. MAT_2 = MA1 ;
  15453. SINON ;
  15454. MOD_1 = MOD_1 ET MO1 ;
  15455. MAT_2 = MAT_2 ET MA1 ;
  15456. FINSI ;
  15457. FIN BOMA11 ;
  15458. SINON ;
  15459. MAT_2 = MAT_1 ;
  15460. FINSI ;
  15461. TAB1.MATTOT = MAT_2 ;
  15462. SI_11 = THETA MOD_1 MAT_2 ( TE1 - TE0 ) ;
  15463. FO1 = BSIGMA MOD_1 SI_11 ;
  15464. SI_12 = SI_13 + SI_11 ;
  15465. EPS_1 = ELAS MOD_1 SI_12 MAT_2 ;
  15466. * ici il faudrait extraire le alpha de mat_2
  15467. * multiplier par ( TE1 - TE0 ) et en faire un EPZZ
  15468. * a rajouter a EPS_1
  15469. AL_P1 = EXCO 'ALPH' MAT_2 'SCAL' ;
  15470. AL_P1 = CHAN 'TYPE' AL_P1 'DEFORMATIONS' ;
  15471. * MAIL1 = EXTR AL_P1 'MAIL' ;
  15472. TCACH = TEXT ' ' ;
  15473. SI ( NON (EXISTE TAB1 VIEW_P )) ;
  15474. TAB1.VIEW_P = TEXT ' ' ;
  15475. TEX2 = TEXT ' ' ;
  15476. TCACH = TEXT ' ' ;
  15477. SI ( EGA ( VALE DIME) 3 ) ;
  15478. TAB1.VIEW_P = 1.E8 1.E8 1.E8 ;
  15479. TCACH = TEXT ' CACH ' ;
  15480. FINSI ;
  15481. FINSI ;
  15482.  
  15483. * OPTI TRAC X ;
  15484. * TRAC CACH TAB1.VIEW_P MAIL1
  15485. ;
  15486. TT_1 = CHAN 'CHAM' ( NOMC 'SCAL' ( TE1 - TE0 )) MOD_1 'RIGIDITE' ;
  15487. TT_1 = CHAN 'TYPE' TT_1 'DEFORMATIONS' ;
  15488. TT_1 = ( AL_P1 * 0.) + TT_1 ;
  15489. * MAIL2 = EXTR TT_1 'MAIL' ;
  15490. * TRAC CACH TAB1.VIEW_P MAIL2 ;
  15491. E_ZZ1 = AL_P1 * TT_1 ;
  15492. E_ZZ1 = CHAN 'STRESSES' MOD_1 E_ZZ1 ;
  15493. E_ZZ1 = EXCO 'SCAL' E_ZZ1 'EPZZ' ;
  15494. EPS_1 = EPS_1 ET E_ZZ1 ;
  15495. MESS '---------------------------------> sortie de EPSCHL';
  15496. FINPROC EPS_1 ;
  15497.  
  15498. *-----------------------------------------------------------------------
  15499. *
  15500. *----------Fin de la procedure EPSCHL
  15501. *
  15502. *----------Debut de la procedure MECASCH1
  15503. *
  15504. *ENTREES TAB1.ZONE_MAT
  15505. * .MODL_MAT .TETMAT .TEXTMECA .BLOCAGE
  15506. * .CHPOTHETA .DEFO_PLANE_GENE
  15507. * .MAXITERATION .L_BAS
  15508. *E/S .VIEW_P .LIS_ATRAITER .MAXITERATION
  15509. * .ITERATION .CHA1 .VIEW_P2
  15510. *SORTIES .MATTOT .L_CONTOUR .PLASTIQUE .DEFO_PLANE_GENE
  15511. * .S_TOTAL .MODTOT .MATTOT
  15512. * .THERMIQUE .NZ
  15513. *-----------------------------------------------------------------------
  15514. *23456789012345678901234567890123456789012345678901234567890123456789012
  15515. * 1 2 3 4 5 6 7
  15516. ************************************************************************
  15517.  
  15518.  
  15519. 'DEBPROC' MECASCH1 TAB1*'TABLE ' ;
  15520. MESS '---------------------------------> entree dans MECASCH1';
  15521. *OPTI ECHO 0 ;
  15522.  
  15523. V1 = VALEUR 'DIME' ;
  15524. SI ( V1 EGA 2) ;
  15525. TFRONT1 = TEXT ' CONTOUR' ;
  15526. TCACH = TEXT ' ' ;
  15527. SINON ;
  15528. TFRONT1 = TEXT ' ENVELOP' ;
  15529. TCACH = TEXT ' CACH ' ;
  15530. FINSI ;
  15531.  
  15532. SI ( NON (EXISTE TAB1 VIEW_P )) ;
  15533. TAB1.VIEW_P = TEXT ' ' ;
  15534. SI ( EGA ( VALE DIME) 3 ) ;
  15535. TAB1.VIEW_P = 1.E8 1.E8 1.E8 ;
  15536. FINSI ;
  15537. FINSI ;
  15538.  
  15539. *SI ( NON ( EXISTE TAB1 MECANIQUE )) ;
  15540. * TAB1.MECANIQUE = FAUX ;
  15541. * MESS ' >>>>>si vous voulez un calcul mecanique ' ;
  15542. * MESS ' >>>>>faire TAB1.MECANIQUE = VRAI ' ;
  15543. *FINSI ;
  15544. *1
  15545. *SI ( TAB1.MECANIQUE ) ;
  15546. * SI ( NON ( EXISTE TAB1 CHPOTHETA )) ;
  15547. * TAB1.CHPOTHETA = TABLE ;
  15548. * FINSI ;
  15549. * XI11 = 0. ;
  15550. SI ( NON ( EXISTE TAB1 LIS_ATRAITER )) ;
  15551. TAB1. LIS_ATRAITER = @INDSCHL (TAB1.CHPOTHETA) ;
  15552. FINSI ;
  15553. LIS1 = TAB1. LIS_ATRAITER ;
  15554. * MESS '>>>> cas a traiter ' ;
  15555. * LIST LIS1 ;
  15556. * SI ( EXISTE TAB1 CHPT_INI ) ;
  15557. * TAB1.CHPOTHETA . 0. = TAB1 . CHPT_INI ;
  15558. * LIS1 = PROG XI11 ;
  15559. * SINON ;
  15560. * XI11 = -1. ;
  15561. * LIS1 = PROG ;
  15562. * FINSI ;
  15563. * SI ( EXISTE TAB1 CHPT_FINAL ) ;
  15564. * SI ( NON ( EXISTE TAB1 CHPT_INI ) ) ;
  15565. * MESS '>>>> IL FALLAIT DONNER UN CHAMP INITIAL >>>>>' ;
  15566. * MESS '>>>> CELA VA SE PLANTER >>>>>' ;
  15567. * FINSI ;
  15568. * XI11 = XI11 + 1. ;
  15569. * MESS '>>>>0.1 ' ;
  15570. * LIS1 = LIS1 ET ( PROG XI11 ) ;
  15571. * TAB1.CHPOTHETA . XI11 = TAB1 . CHPT_FINAL ;
  15572. * FINSI ;
  15573. * SI ( (TAB1 . PERMANENT) EGA VRAI ) ;
  15574. * I11 = 0 ;
  15575. * REPETER BOCAP1 ( DIME ( TAB1 . LIS_NO_ATRAITER) ) ;
  15576. * SI ( EXISTE TAB1 CHPT_FINAL ) ; QUITTER BOCAP1; FINSI ;
  15577. * XI11 = XI11 + 1. ;
  15578. * MESS '>>>>0.2 ' ;
  15579. * I11 = I11 + 1 ;
  15580. * I1 = EXTR TAB1.LIS_NO_ATRAITER I11 ;
  15581. * TAB1.CHPOTHETA . XI11 = TAB1.I1 ;
  15582. * LIS1 = LIS1 ET ( PROG XI11 ) ;
  15583. * FIN BOCAP1 ;
  15584. * FINSI ;
  15585. * SI ( ( ((TAB1 . TRANSITOIRE) EGA VRAI ) ET
  15586. * (TAB1 . PERMANENT) EGA FAUX ) ) ;
  15587. * REPETER BOCAT1 ;
  15588. * SI ( EXISTE TAB1 CHPT_FINAL); QUITTER BOCAT1; FINSI ;
  15589. * XI11 = XI11 + 1. ;
  15590. * MESS '>>>>0.3 ' ;
  15591. * I11 = ENTIER XI11 ;
  15592. * SI ( NON ( EXISTE TAB1 I11 )); QUITTER BOCAT1; FINSI ;
  15593. * TAB1.CHPOTHETA . XI11 = TAB1. I11 ;
  15594. * LIS1 = LIS1 ET ( PROG XI11 ) ;
  15595. * FIN BOCAT1 ;
  15596. * FINSI ;
  15597. *
  15598. * XF1 = PROG (DIME LIS1) * 1. ;
  15599. * F1 = FORCE FY 0. ( TAB1 . L_BAS ) ;
  15600. * CHA1 = CHAR F1 ( EVOL MANU LIS1 XF1 ) ;
  15601. IPP1 = 0 ;
  15602. REPETER BOMA10 ;
  15603. IPP1 = IPP1 + 1 ;
  15604. SI ( EXISTE (TAB1.ZONE_MAT) IPP1 ) ;
  15605. SI ( IPP1 EGA 1 ) ;
  15606. STOT1 = TAB1.ZONE_MAT . IPP1 ;
  15607. CONTT1 = TFRONT1 (TAB1.ZONE_MAT . IPP1 ) ;
  15608. SINON ;
  15609. STOT1 = STOT1 ET (TAB1.ZONE_MAT . IPP1) ;
  15610. CONTT1 = CONTT1 ET ( TFRONT1 (TAB1.ZONE_MAT. IPP1)) ;
  15611. FINSI ;
  15612. SINON ;
  15613. QUITTER BOMA10 ;
  15614. FINSI ;
  15615. FIN BOMA10 ;
  15616. TRAC TCACH TAB1.VIEW_P CONTT1 ;
  15617. SI ( EXISTE TAB1 VIEW_P2 ) ;
  15618. TRAC TCACH TAB1.VIEW_P2 CONTT1 ;
  15619. FINSI ;
  15620. TAB1.L_CONTOUR = CONTT1 ;
  15621. TAB1.S_TOTAL = STOT1 ;
  15622. * on calcule une temperature moyenne de l intervalle
  15623. CHP_TM1 = ( ((TAB1.CHPOTHETA .(EXTR 1 LIS1)) + (TAB1.CHPOTHETA .(EXTR (DIME LIS1) LIS1))) * 0.5 ) ;
  15624. TAB1.>CHP_TM1 = CHP_TM1 ;
  15625. @DEFMAT TAB1 ;
  15626. MOD_1 = TAB1.MODTOT;
  15627. MAT_1 = TAB1.MATTOT ;
  15628. RIG_1 = RIGI MOD_1 MAT_1 ;
  15629. SI ( NON (EXISTE TAB1 PLASTIQUE )) ;
  15630. TAB1.PLASTIQUE = VRAI ;
  15631. FINSI ;
  15632. SI ( NON (EXISTE TAB1 DEFO_PLANE_GENE )) ;
  15633. TAB1.DEFO_PLANE_GENE = FAUX ;
  15634. FINSI ;
  15635.  
  15636.  
  15637. MESS '>>>>>>> 2 >>>>>>' ;
  15638. SI ( (TAB1.PLASTIQUE ) ET ( NON TAB1.DEFO_PLANE_GENE )) ;
  15639. * SI ( NON (EXISTE TAB1 PRECISION )) ;
  15640. * TAB1.PRECISION = 0.01 ;
  15641. * FINSI ;
  15642. MESS '>>>>>>> 2.1 >>>>>>' ;
  15643. SI ( NON ( EXISTE TAB1 MAXITERATION ) ) ;
  15644. TAB1.MAXITERATION = 100 ;
  15645. FINSI ;
  15646. * SI ( NON (EXISTE TAB1 ACCELERATION) ) ;
  15647. * TAB1.ACCELERATION = 20 ;
  15648. * FINSI ;
  15649. TAB1.THERMIQUE = VRAI ;
  15650. TAB1.ITERATION = KSI ;
  15651.  
  15652.  
  15653. SI (NON (EXISTE TAB1 CHA1)) ;
  15654. XF1 = PROG (DIME LIS1) * 1. ;
  15655. F1 = FORCE FY 0. (TAB1 . L_BAS) ;
  15656. CHARG1 = CHAR F1 ( EVOL MANU LIS1 XF1 ) ;
  15657. * TAB1.'CHA1' = CHA1 ;
  15658. SINON ;
  15659. CHARG1 = TAB1.'CHA1' ;
  15660. FINSI ;
  15661.  
  15662. TAB1.NZ = 0.;
  15663. * TAB1.LIG1 = TAB1.L_BAS ;
  15664. * TAB1.TINI = 150. ;
  15665. *JS 19/10/94 je ne vois pas a quoi sert .TINI
  15666. * TAB1.TINI = 0. ;
  15667. * CHAI = CHAR (TAB1 .CHARMECAFI) ( EVOL MANU LIS1 XF1 ) ;
  15668. MESS '>>>>>>>>DEBUT RIGIDITE ' ;
  15669. RIG10 = RIG_1 et ( TAB1 . BLOCAGE ) ;
  15670. * CHAI = CHAR (TAB1 .CHARMECAFI) ( EVOL MANU LIS1 XF1 ) ;
  15671. MESS '>>>>>>>>APPEL a NONLIN' ;
  15672. NONLIN RIG10 MAT_1 CHARG1 LIS1 MOD_1 TAB1 ;
  15673. FINSI ;
  15674. MESS '---------------------------------> sortie de MECASCH1';
  15675. FINPROC ;
  15676.  
  15677. *-----------------------------------------------------------------------
  15678. *
  15679. *----------Fin de la procedure MECASCH1
  15680. *
  15681. *----------Debut de la procedure MECASCH2
  15682. *
  15683. *-----------------------------------------------------------------------
  15684. *23456789012345678901234567890123456789012345678901234567890123456789012
  15685. * 1 2 3 4 5 6 7
  15686. ************************************************************************
  15687.  
  15688. 'DEBPROC' MECASCH2 TAB1*'TABLE ' ;
  15689.  
  15690. MESS '---------------------------------> entree dans MECASCH2';
  15691. SI ( NON (EXISTE TAB1 LM_SIGCOMP )) ;
  15692. TAB1.LM_SIGCOMP = MOTS 'VONM' ;
  15693. FINSI ;
  15694. SI ( NON (EXISTE TAB1 L_CASADEPOU )) ;
  15695. TAB1.L_CASADEPOU = PROG (EXTR (DIME LIS1) LIS1) ;
  15696. FINSI ;
  15697. V1 = VALEUR 'DIME' ;
  15698. SI ( NON (EXISTE TAB1 VIEW_P )) ;
  15699. TAB1.VIEW_P = TEXT ' ' ;
  15700. SI ( EGA ( VALE DIME) 3 ) ;
  15701. TAB1.VIEW_P = 1.E8 1.E8 1.E8 ;
  15702. FINSI ;
  15703. FINSI ;
  15704.  
  15705. SI ( V1 EGA 2) ;
  15706. TFRONT1 = TEXT ' CONTOUR' ;
  15707. * modif mitteau
  15708. * TCACH = TEXT ' ' ;
  15709. TCACH = ' ' ;
  15710. SINON ;
  15711. TFRONT1 = TEXT ' ENVELOP' ;
  15712. TCACH = ' CACH ' ;
  15713. * TCACH = TEXT ' CACH ' ;
  15714. FINSI ;
  15715.  
  15716. IPP1 = 0 ;
  15717. REPETER BOMA10 ;
  15718. IPP1 = IPP1 + 1 ;
  15719. SI ( EXISTE (TAB1.ZONE_MAT) IPP1 ) ;
  15720. SI ( IPP1 EGA 1 ) ;
  15721. STOT1 = TAB1.ZONE_MAT . IPP1 ;
  15722. CONTT1 = TFRONT1 (TAB1.ZONE_MAT . IPP1 ) ;
  15723. MOD_T1 = TAB1.MODL_MAT. IPP1 ;
  15724. SINON ;
  15725. STOT1 = STOT1 ET (TAB1.ZONE_MAT . IPP1) ;
  15726. CONTT1 = CONTT1 ET ( TFRONT1 (TAB1.ZONE_MAT. IPP1)) ;
  15727. MOD_T1 = MOD_T1 ET TAB1.MODL_MAT. IPP1 ;
  15728. FINSI ;
  15729. SINON ;
  15730. QUITTER BOMA10 ;
  15731. FINSI ;
  15732. FIN BOMA10 ;
  15733.  
  15734. TAB1.L_CONTOUR = CONTT1 ;
  15735. TAB1.S_TOTAL = STOT1 ;
  15736.  
  15737. SI ( NON (EXISTE TAB1 S_ADEPOU )) ;
  15738. CONTT1 = TAB1.L_CONTOUR ;
  15739. STOT1 = TAB1.S_TOTAL ;
  15740. MOTOT1 = MOD_T1 ;
  15741. SINON ;
  15742. STOT1 = TAB1.S_ADEPOU ;
  15743. MOTOT1 = TAB1.MO_ADEPOU ;
  15744. SI ( NON (EXISTE TAB1 C_ADEPOU )) ;
  15745. CONTT1 = TFRONT1 TAB1.S_ADEPOU ;
  15746. SINON ;
  15747. CONTT1 = TAB1.C_ADEPOU ;
  15748. FINSI ;
  15749. FINSI ;
  15750.  
  15751. TAC8 = TABLE ;
  15752. TAC8.1 = 'NOLI ' ;
  15753. TAC8.2 = 'MARQ PLUS REGU' ;
  15754. TAC8.3 = 'MARQ ETOI REGU' ;
  15755. TAC8.4 = 'MARQ LOSA REGU' ;
  15756. TAC8.5 = 'MARQ CARR REGU' ;
  15757. TAC8.6 = 'MARQ TRIA REGU' ;
  15758. TAC8.7 = 'MARQ TRIB REGU' ;
  15759. TAC8.8 = 'MARQ PLUS REGU' ;
  15760. TAC8.9 = 'MARQ ETOI REGU' ;
  15761. TAC8.10 = 'MARQ CROI REGU' ;
  15762.  
  15763. SI ( NON (EXISTE TAB1 LM_SIGCOMP )) ;
  15764. TAB1.LM_SIGCOMP = MOTS 'VONM' ;
  15765. FINSI ;
  15766.  
  15767. SI ( NON (EXISTE TAB1 L_CASADEPOU )) ;
  15768. TAB2 = INDE TAB1.RESUDEPL ;
  15769. MESS '>>>>>>ESSAI DIME DE TAB2' ( DIME TAB2 ) ;
  15770. I1 = 0 ;
  15771.  
  15772. REPETER BINDE1 ;
  15773. I1 = I1 + 1 ;
  15774. SI (EXISTE TAB2 I1 ) ;
  15775. XX2 = TAB2.I1 ;
  15776. SINON ;
  15777. QUITTER BINDE1 ;
  15778. FINSI ;
  15779. FIN BINDE1 ;
  15780.  
  15781. TAB1.L_CASADEPOU = PROG XX2 ;
  15782. FINSI ;
  15783.  
  15784. TCACH = TEXT ' ' ;
  15785. SI ( EGA ( VALE DIME) 3 ) ;
  15786. TCACH = TEXT ' CACH ' ;
  15787. FINSI ;
  15788.  
  15789. MOD_1 = TAB1.MODTOT ;
  15790. MAT_1 = TAB1.MATTOT ;
  15791. *
  15792. *JS 10/94 introduction option TAB1.TRAC_DEFOCONT
  15793. SI( NON ( EXISTE TAB1 TRAC_DEFOCONT )) ;
  15794. TAB1.TRAC_DEFOCONT = VRAI ;
  15795. FINSI ;
  15796. SI TAB1.TRAC_DEFOCONT ;
  15797. MONMAIL = CONTT1 ;
  15798. SINON ;
  15799. MONMAIL = STOT1 ;
  15800. FINSI ;
  15801. SI ( (TAB1.PLASTIQUE ) ET ( NON TAB1.DEFO_PLANE_GENE )) ;
  15802. MESS '>>>>>>> 3.1.0 >>>>>>' ;
  15803. I1 = 0 ;
  15804. REPETER BDEPO1 ( DIME TAB1.L_CASADEPOU ) ;
  15805. I1 = I1 + 1 ;
  15806. XIT1 = EXTR I1 TAB1.L_CASADEPOU ;
  15807. VMI1 = VMIS MOD_1 TAB1.RESUCONT.XIT1 ;
  15808. SIRESU1 = ET TAB1.RESUCONT.XIT1 VMI1 ;
  15809. SIRESUA = ET TAB1.RESUVARI.XIT1 VMI1 ;
  15810.  
  15811. DEF0 = DEFO MONMAIL TAB1.RESUDEPL.XIT1 0. ;
  15812. DEF5 = DEFO MONMAIL TAB1.RESUDEPL.XIT1 20. ROUGE ;
  15813. TITRE 'TIME' XIT1 ' structure temperature' ;
  15814. MESS '>>>>>>> 3.1.1 >>>>>>' ;
  15815. TMMM1 = MAXI (TAB1.'CHPOTHETA'.XIT1) ;
  15816. TMMI1 = MINI (TAB1.'CHPOTHETA'.XIT1) ;
  15817. DTMI1 = ABS (TMMM1 - TMMI1) ;
  15818.  
  15819. SI (EXISTE TAB1 TRAC_THERM) ;
  15820. SI (TAB1.TRAC_THERM EGA VRAI ) ;
  15821. SI( DTMI1 >EG 0.005 ) ;
  15822. * modif raph
  15823. * MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 TAB1.'CHPOTHETA'.XIT1;
  15824. * TRAC TCACH TAB1.VIEW_P MC_CHAM MC_MODL MC_MAIL CONTT1;
  15825. * SI ( EXISTE TAB1 VIEW_P2 ) ;
  15826. * MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 TAB1.'CHPOTHETA'.XIT1;
  15827. * TRAC TCACH TAB1.VIEW_P2 MC_CHAM MC_MODL MC_MAIL CONTT1;
  15828. * FINSI ;
  15829. TRAC TCACH TAB1.VIEW_P TAB1.'CHPOTHETA'.XIT1 CONTT1 ;
  15830. SI ( EXISTE TAB1 VIEW_P2 ) ;
  15831. TRAC TCACH TAB1.VIEW_P2 TAB1.'CHPOTHETA'.XIT1 CONTT1;
  15832. FINSI ;
  15833.  
  15834. FINSI ;
  15835. FINSI ;
  15836. FINSI ;
  15837.  
  15838. TITRE 'TIME' XIT1 ' structure deformation' ;
  15839. MESS '>>>>>>> 3.1.3 >>>>>>' ;
  15840. * TRAC TCACH TAB1.VIEW_P (ET DEF0 DEF5 ) ;
  15841. TRAC CACH TAB1.VIEW_P (ET DEF0 DEF5 ) ;
  15842. SI ( EXISTE TAB1 VIEW_P2 ) ;
  15843. * TRAC TCACH TAB1.VIEW_P2 ( ET DEF0 DEF5 ) ;
  15844. TRAC CACH TAB1.VIEW_P2 ( ET DEF0 DEF5 ) ;
  15845. FINSI ;
  15846.  
  15847. I2 = 0 ;
  15848. REPETER BDEPO2 ( DIME TAB1.LM_SIGCOMP) ;
  15849. I2 = I2 + 1 ;
  15850. MOCOMP = EXTR TAB1.LM_SIGCOMP I2 ;
  15851. TITRE 'TIME' XIT1 MOCOMP ' STRESSES' ;
  15852. SI (( EGA MOCOMP 'VMIS') OU ( EGA MOCOMP 'VONM') );
  15853. MOCOMP = 'SCAL' ;
  15854. * SINON ;
  15855. * MC_CHAM MC_MODL MC_MAIL =
  15856. * @CHAQT MOTOT1 ( EXCO SIRESUA MOCOMP );
  15857. * TRAC CACH TAB1.VIEW_P MOD_1
  15858. * MC_CHAM MC_MODL MC_MAIL CONTT1 ;
  15859. FINSI ;
  15860.  
  15861. MESS '>>>>>>> 3.1.4 >>>>>>' ;
  15862. CHCONT1 = (REDU (EXCO SIRESU1 MOCOMP) MOTOT1) ;
  15863.  
  15864. SI ( EGA (MAXI CHCONT1) (MINI CHCONT1) 1.0E-19) ;
  15865. MESS 'Champs constant => on donne la valeur ' ;
  15866. LIST MOCOMP ;
  15867. LIST (MAXI CHCONT1) ;
  15868. SINON ;
  15869. MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 CHCONT1 ;
  15870. @TRASCH TCACH TAB1.VIEW_P MC_CHAM MC_MODL MC_MAIL STOT1 CONTT1 ;
  15871. FINSI ;
  15872.  
  15873. SI ( EXISTE TAB1 VIEW_P2 ) ;
  15874. SI (EGA (MAXI CHCONT1) (MINI CHCONT1) 1.0E-19) ;
  15875. MESS 'Champs constant => on donne la valeur ' ;
  15876. LIST MOCOMP ;
  15877. LIST (MAXI CHCONT1) ;
  15878. SINON ;
  15879. MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 CHCONT1 ;
  15880. @TRASCH TCACH TAB1.VIEW_P2 MC_CHAM MC_MODL MC_MAIL STOT1 CONTT1 ;
  15881. FINSI ;
  15882. FINSI ;
  15883.  
  15884. FIN BDEPO2 ;
  15885. FIN BDEPO1 ;
  15886. I3 = 0 ;
  15887. REPETER BDEPO3 ( DIME TAB1.L_CASADEPOU ) ;
  15888. I3 = I3 + 1 ;
  15889. XIT1 = EXTR I3 TAB1.L_CASADEPOU ;
  15890. DEPL_1 = TAB1.RESUDEPL.XIT1 ;
  15891. SI_1 = TAB1.RESUCONT.XIT1 ;
  15892. * EPS_2 = TAB1.RESUDEFI.XIT1 + (ELAS MOD_1 SI_1 MAT_1) ;
  15893. * MOD_1 = TAB1.MODTOT ;
  15894. EPS_1 = EPSI MOD_1 DEPL_1 ;
  15895. EPS_1 = EPS_1 ET ( EXCO EPSE TAB1.RESUVARI.XIT1) ;
  15896. I4 = 0 ;
  15897. REPETER BDEPO4 ( DIME TAB1.LM_EPSCOMP) ;
  15898. I4 = I4 + 1 ;
  15899. MOCOMP = EXTR TAB1.LM_EPSCOMP I4 ;
  15900. TITRE 'TIME' XIT1 MOCOMP ' STRAINS' ;
  15901. SI ( EGA MOCOMP 'EPSE') ;
  15902. TITRE 'TIME' XIT1 ' EPSE PLASTIC EQUIVALENT STRAINS ';
  15903.  
  15904. * SINON ;
  15905. * MC_CHAM MC_MODL MC_MAIL =
  15906. * @CHAQT MOTOT1 ( EXCO EPS_2 MOCOMP );
  15907. * TRAC CACH TAB1.VIEW_P MOD_1 MC_CHAM MC_MODL MC_MAIL
  15908. * CONTT1;
  15909.  
  15910. FINSI ;
  15911.  
  15912. SI (( EGA MOCOMP 'EPZZ') ET ( V1 EGA 2 )) ;
  15913. EPS_3 = TAB1.RESUDEFI.XIT1 + (EPSCHL MOD_1 SI_1 (TAB1.CHPOTHETA. 0.) (TAB1.CHPOTHETA.XIT1) TAB1 );
  15914. TITRE 'TIME' XIT1 MOCOMP ' STRAINS' ;
  15915. MESS '>>>>>>> 3.1.5 >>>>>>' ;
  15916. MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 ( REDU ( EXCO EPS_3 MOCOMP ) MOTOT1 );
  15917. @TRASCH TCACH TAB1.VIEW_P MC_CHAM MC_MODL MC_MAIL STOT1 CONTT1 ;
  15918. SI ( EXISTE TAB1 VIEW_P2 );
  15919. MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 ( REDU ( EXCO EPS_3 MOCOMP ) MOTOT1 );
  15920. @TRASCH TCACH TAB1.VIEW_P2 MC_CHAM MC_MODL MC_MAIL STOT1 CONTT1;
  15921. FINSI ;
  15922. SINON ;
  15923. MESS '>>>>>>> 3.1.6 >>>>>>' ;
  15924. SI ( EGA (MAXI ( ( REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 ))) (MINI ( ( REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 ))) 1.0E-19) ;
  15925. MESS 'Champs constant => on donne la valeur ' ;
  15926. LIST MOCOMP ;
  15927. LIST (MAXI ( ( REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 )));
  15928. SINON ;
  15929. MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 ( REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 );
  15930. @TRASCH TCACH TAB1.VIEW_P MC_CHAM MC_MODL MC_MAIL STOT1 CONTT1 ;
  15931. FINSI ;
  15932. SI ( EXISTE TAB1 VIEW_P2 ) ;
  15933. SI ( EGA (MAXI (REDU ( EXCO EPS_1 MOCOMP ) MOTOT1)) (MINI (REDU ( EXCO EPS_1 MOCOMP ) MOTOT1)) 1.0E-19) ;
  15934. MESS 'Champs constant => on donne la valeur ' ;
  15935. LIST MOCOMP ;
  15936. LIST (MAXI ( ( REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 ))) ;
  15937. SINON ;
  15938. MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 ( REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 ) ;
  15939. @TRASCH TCACH TAB1.VIEW_P2 MC_CHAM MC_MODL MC_MAIL STOT1 CONTT1;
  15940. FINSI ;
  15941. FINSI ;
  15942. FINSI ;
  15943. FIN BDEPO4 ;
  15944. FIN BDEPO3 ;
  15945. * DEPOMIMA TAB1 ;
  15946. FINSI ;
  15947. MESS '---------------------------------> sortie de MECASH2';
  15948. FINPROC ;
  15949. **** @OMBJET
  15950.  
  15951. DEBPROC @OMBJET TAB1*TABLE ;
  15952. *
  15953. ***************************************************
  15954. * PROGRAMME CASTEM GERANT L'APPEL AUX DIFFERENTES *
  15955. * PROCEDURES POUR REMONTER LES LIGNES DE CHAMP *
  15956. * SELON LA METHODE CHOISIE. *
  15957. * (VERSION DE @OMBRAGE POUR JET) *
  15958. ***************************************************
  15959. * Modif : *
  15960. * 09/11/01 (A.MOAL) : sens de remontee selon le *
  15961. * signe de dpsi *
  15962. * 23/11/01 (A.MOAL) : suppression du sens de *
  15963. * remontee suivant le signe *
  15964. * de dpsi *
  15965. * 23/11/01 (A.MOAL) : possibilite d'imposer le *
  15966. * sens de remontee *
  15967. ***************************************************
  15968. *
  15969. MESS '---------------------------------> calling @OMBJET';
  15970.  
  15971. *--- VARIABLES D'ENTREE :
  15972.  
  15973. MAIL1 = TAB1.<S_OMBRE ;
  15974. VMAIL1 = TAB1.<V_OMBRE_N;
  15975. GMAIL1 = TAB1.<S_OMBRE_N;
  15976.  
  15977. MAIL2 = TAB1.<S_OMBRANT ;
  15978. VMAIL2 = TAB1.<V_OMBRANT_N;
  15979. GMAIL2 = TAB1.<S_OMBRANT_N;
  15980. IMETHOD = TAB1.<METHODE_REMONTEE ;
  15981.  
  15982. SI (EXIS TAB1 <SAUV_PTS_OMBRANTS ) ;
  15983. REPO = TAB1.<SAUV_PTS_OMBRANTS ;
  15984. SINON ;
  15985. REPO = FAUX ;
  15986. FINSI ;
  15987.  
  15988. si (non (exis tab1 <reprise)) ;
  15989. tab1.<reprise = faux ;
  15990. finsi ;
  15991.  
  15992. * --- distance de remontee precedente en cas de reprise
  15993. si (tab1.<reprise) ;
  15994. d_prec = tab1.<LONGUEUR_REMONTEE ;
  15995. sinon ;
  15996. d_prec = 0. ;
  15997. finsi ;
  15998.  
  15999. DMAX2 = TAB1.<DIST_AVEC_TEST ;
  16000. PASB2 = TAB1.<PAS_AVEC_TEST ;
  16001.  
  16002. REPV = EXIS TAB1 <DIST_SANS_TEST ;
  16003. SI REPV ;
  16004. DMAX1 = TAB1.<DIST_SANS_TEST ;
  16005. PASB1 = TAB1.<PAS_SANS_TEST ;
  16006. FINSI ;
  16007. *
  16008. * --- Si le calcul est une reprise, on ne re-calcule pas CHSIGN1
  16009. *
  16010. si (non (tab1.<reprise));
  16011. * --- VARIABLES D'ENTREE, Valeurs par defaut
  16012. *
  16013. @VDEFJET TAB1 ;
  16014.  
  16015. SENS0 = TAB1.<SENS_REMONTEE ;
  16016. *
  16017. * ----
  16018. MESS '>@OMBJET> Construction du champoint B scalaire N';
  16019. *
  16020. *---- lecture de la carte de champ magnetique dans un fichier
  16021. @LECTB TAB1 ;
  16022. TITRE '@OMBJET : MAGNETIC DOMAIN, STUDIED AND SHADING OBJECT';
  16023. *TRAC (TAB1.<GRILLE_B ET MAIL2 ET MAIL1) ;
  16024. TRAC ((ENVE TAB1.<GRILLE_B) ET (ENVE MAIL2) ET (ENVE MAIL1)) ;
  16025.  
  16026. * ---- Calcul du champ dans le repere global
  16027.  
  16028. * ---- coordonnees dans le repere du maillage
  16029. XM0 = COOR 1 GMAIL1 ;
  16030. YM0 = COOR 2 GMAIL1 ;
  16031. DIM0 = VALEUR DIME ;
  16032. SI (DIM0 EGA 2) ;
  16033. ZM0 = XM0 * 0. ;
  16034. BNUL = XM0 * 0. ;
  16035. SINON ;
  16036. ZM0 = COOR 3 GMAIL1 ;
  16037. FINSI ;
  16038.  
  16039. *---- Coordonnees dans le repere global du
  16040. *---- tore (pas de changement de repere)
  16041. XG_OLD = XM0 ;
  16042. YG_OLD = YM0 ;
  16043. ZG_OLD = ZM0 ;
  16044.  
  16045. TAB1.<MAILLAGE_B = MAIL1 ;
  16046. BR BZ BPHI = @MAGNB TAB1 ;
  16047.  
  16048. *---- composantes de B dans le repere du maillage
  16049. PHI = ATG (COOR 2 MAIL1) (COOR 1 MAIL1) ;
  16050. *AM*11/09/01*BX = BR * (COS PHI) + (BPHI * (SIN PHI));
  16051. *AM*11/09/01*BY = BR * (SIN PHI) - (BPHI * (COS PHI));
  16052. BXM = BR * (COS PHI) - (BPHI * (SIN PHI));
  16053. BYM = BR * (SIN PHI) + (BPHI * (COS PHI));
  16054. BZM = BZ ;
  16055. MENAGE ;
  16056. *
  16057. *---- calcul des normales a la surface calculees
  16058. *---- dans le repere du maillage
  16059. si ((non (exis tab1 <nxm)) et ((nbno GMAIL1) ega (nbno MAIL1)));
  16060. MESS 'APPEL DE VNORM3D POUR LE MAILLAGE OMBRE';
  16061. NXM NYM NZM = @VNORM3D VMAIL1 GMAIL1 ;
  16062. tab1.<nxm = NXM ;
  16063. tab1.<nym = NYM ;
  16064. tab1.<nzm = NZM ;
  16065. sinon ;
  16066. NXM = tab1.<nxm ;
  16067. NYM = tab1.<nym ;
  16068. NZM = tab1.<nzm ;
  16069. finsi ;
  16070.  
  16071. *---- calcul du produit scalaire
  16072. PVBVN = (BXM*NXM) + (BYM*NYM) + (BZM*NZM);
  16073. CHSIGN0 = PVBVN / (ABS PVBVN) ;
  16074.  
  16075. SI (SENS0 NEG 0) ;
  16076. * ---- possibilite d'imposer le sens de remontee des lignes
  16077. * ---- sans tenir compte du critere sur b.n
  16078. CHSIGN0 = (ABS CHSIGN0) * SENS0 ;
  16079. FINSI ;
  16080.  
  16081. *---- debut modif (09/11/01 - A.Moal)
  16082. *---- mise en commentaire des modifs le 23/11/01 - A.Moal
  16083. * l'idee abandonnee était :
  16084. * Si SENS0 = 0 alors on remonte les lignes de champ avec
  16085. * pour seul critere le sens de la normale sortante.
  16086. * Si SENS0 = 1, on remonte dans le sens de B lorsque dpsi
  16087. * est positif et dans le sens de -B lorsque dpsi est
  16088. * negatif à condition que ce soit dans le sens de
  16089. * la normale sortante (sinon la ligne n'est pas
  16090. * remontee pour le point considere).
  16091. * Si SENS0 = - 1, on remonte dans le sens de B lorsque
  16092. * dpsi est negatif et dans le sens de -B lorsque
  16093. * dpsi est positif à condition que ce soit dans le
  16094. * sens de la normale sortante (sinon la ligne n'est
  16095. * pas remontee pour le point considere).
  16096. *SI (SENS0 NEG 0) ;
  16097. * ---- on definit un sens de remontee en fonction de dpsi
  16098. * CHDPSI = @DPSI TAB1 ;
  16099. * SIGDPSI = CHDPSI * SENS0 / (ABS CHDPSI) ;
  16100. * TITRE '@OMBJET : DPSI ON THE SHADOWED MESH' ;
  16101. * TRAC CHDPSI MAIL1 ;
  16102. * TITRE '@OMBJET : SIGN OF DPSI ON THE SHADOWED MESH' ;
  16103. * TRAC SIGDPSI MAIL1 ;
  16104. * ----- on ne remonte que les points dont le sens de remontee
  16105. * ----- impose par <SENS_REMONTEE est le meme qu'avec le critere de
  16106. * ----- la normale sortante (CHSIGN0 = 0. pour les autres points)
  16107. * CHSIGN0 = CHSIGN0 * ((CHSIGN0 * SIGDPSI) MASQUE SUPERIEUR 0.);
  16108. *FINSI ;
  16109. *VB1 = @CVECT (BXM*CHSIGN0) (BYM*CHSIGN0) (BZM*CHSIGN0)
  16110. * TAB1.LFLUX_EXTE VERT;
  16111. *TITRE '@OMBJET : DIRECTION FOR COMING UP THE MAGNETIC LINES' ;
  16112. *TRAC VB1 MAIL1 ;
  16113. *---- fin mise en commentaire
  16114. *---- fin modif
  16115.  
  16116. *---- PROJECTION SUR LE MAILLAGE FIN INITIAL
  16117. *---- BOUCLE SUR CHAQUE POINT DU MAILLAGE FIN
  16118. MAILPT = CHAN MAIL1 POI1 ;
  16119. NBNFIN = NBNO MAIL1 ;
  16120. PT1 = ELEM MAILPT POINT 1 ;
  16121. PP = GMAIL1 POIN PROC PT1 ;
  16122. VAL1 = EXTR CHSIGN0 SCAL PP ;
  16123. MAILP1 = MANU POI1 PT1 ;
  16124. CHSIGN1 = MANU CHPO MAILP1 1 SCAL VAL1 'NATURE' DIFFUS ;
  16125. REPETER BOUPI (NBNFIN - 1) ;
  16126. I = &BOUPI + 1 ;
  16127. PTI = ELEM MAILPT POINT I ;
  16128. PPI = GMAIL1 POIN PROC PTI ;
  16129. VALI = EXTR CHSIGN0 SCAL PPI ;
  16130. MAILPI = MANU POI1 PTI ;
  16131. CHI = MANU CHPO MAILPI 1 SCAL VALI 'NATURE' DIFFUS ;
  16132. CHSIGN1 = CHSIGN1 ET CHI ;
  16133. FIN BOUPI ;
  16134.  
  16135. *---- Complement de TAB1.<CHSIGN1 sur les noeuds dont on veut remonter
  16136. *---- les lignes de champ
  16137. si (exis tab1 <remontee) ;
  16138. NPTS = DIME tab1 . <remontee . <point ;
  16139. REPETER BOUPTS1 NPTS ;
  16140. pt1 = tab1 . <remontee . <point . &BOUPTS1 ;
  16141. PP1 = MAIL1 POIN PROC PT1 ;
  16142. MAILP1 = MANU POI1 PT1 ;
  16143. VAL1 = EXTR CHSIGN1 SCAL PP1 ;
  16144. CH1 = MANU CHPO MAILP1 1 SCAL VAL1 'NATURE' DIFFUS ;
  16145. CHSIGN1 = CHSIGN1 ET CH1 ;
  16146. FIN BOUPTS1 ;
  16147. finsi ;
  16148.  
  16149. TAB1.<CHSIGN = CHSIGN1 ;
  16150. finsi ;
  16151.  
  16152. * === NOMBRE DE PAS MAXIMUM A EFFECTUER PAR LA PROCEDURE
  16153. * RM310898 ruse pour ne pas avoir de pb avec les parties entieres
  16154. * apres constat comportement erratique
  16155.  
  16156. nbpas2 = ENTIER ((DMAX2 + (PASB2/1000.))/PASB2) ;
  16157. TAB1.<NBPAS2 = NBPAS2 ;
  16158. DMAX0 = (NBPAS2 * PASB2) + d_prec ;
  16159.  
  16160. si (exis tab1 <DIST_SANS_TEST) ;
  16161. nbpas1 = ENTIER ((DMAX1 + (PASB1/1000.))/PASB1) ;
  16162. TAB1.<NBPAS1 = NBPAS1 ;
  16163. DMAX0 = (NBPAS1 * PASB1) + (NBPAS2 * PASB2) + d_prec ;
  16164. finsi ;
  16165.  
  16166. *
  16167. * --- Choix du test d'intersection ANALYTIQUE (par defaut) ou GEOMETRIQUE
  16168. *
  16169. SI (NON (EXIS TAB1 <METHODE_INTERSECTION)) ;
  16170. TAB1.<METHODE_INTERSECTION = ANALYTIQUE ;
  16171. FINSI ;
  16172.  
  16173. *
  16174. * --- Appel de la procedure utiliant la methode analytique
  16175. *
  16176. SI (EGA TAB1.<METHODE_INTERSECTION ANALYTIQUE) ;
  16177. @ANAJET TAB1 ;
  16178. * ---- on retrouve la forme initiale
  16179. FORM (TAB1.<DEPLACE * (-1.)) ;
  16180. FINSI ;
  16181. *
  16182.  
  16183.  
  16184. * --- Appel de la procedure utiliant la methode geometrique
  16185. *
  16186. SI (EGA TAB1.<METHODE_INTERSECTION GEOMETRIQUE) ;
  16187. CHDIST0 MAI1TRAV POMB = @TESTGEO TAB1 ;
  16188. TAB1.<CHDIST = CHDIST0;
  16189. TAB1.<MAI1TRAV = MAI1TRAV ;
  16190. FINSI ;
  16191.  
  16192. MESS '>@OMBJET> - execution correcte' ;
  16193. MESS '>@OMBJET> remontee en metre :' TAB1.<LONGUEUR_REMONTEE ;
  16194.  
  16195. SI (EGA (TAB1.<CONNEXION_MAX) 0.) ;
  16196. MESS ' ' ;
  16197. MESS '>@OMBJET> Pas d ombrage de OMBRE par OMBRANT';
  16198. MESS ' ' ;
  16199. SINON;
  16200. MESS '>@OMBJET> mini - maxi de la longueur de connection' (mini TAB1.<CHDIST) TAB1.<CONNEXION_MAX ;
  16201. FINSI;
  16202.  
  16203. SI REPO ;
  16204. TAB1.<P_OMBRANTS = POMB ;
  16205. FINSI ;
  16206. * --------------- VARIABLES DE SORTIE GENERALES :
  16207. TAB1.<MASQOMB = MASQ TAB1.<CHDIST EGSUPE (DMAX0 - (PASB2/1000.)) ;
  16208. *------------------------------------
  16209.  
  16210. *
  16211. MESS '---------------------------------> exiting @OMBJET';
  16212. FINPROC ;
  16213. **** @OMBRAGE
  16214. DEBPROC @OMBRAGE TAB1*TABLE ;
  16215. *
  16216. ***************************************************
  16217. * PROGRAMME CASTEM GERANT L'APPEL AUX DIFFERENTES *
  16218. * PROCEDURES POUR REMONTER LES LIGNES DE CHAMP *
  16219. * SELON LA METHODE CHOISIE *
  16220. ***************************************************
  16221. *
  16222. MESS '---------------------------------> calling @OMBRAGE';
  16223.  
  16224. *--- VARIABLES D'ENTREE :
  16225.  
  16226. MAIL1 = TAB1.<S_OMBRE ;
  16227. VMAIL1 = TAB1.<V_OMBRE_N;
  16228. GMAIL1 = TAB1.<S_OMBRE_N;
  16229.  
  16230. MAIL2 = TAB1.<S_OMBRANT ;
  16231. VMAIL2 = TAB1.<V_OMBRANT_N;
  16232. GMAIL2 = TAB1.<S_OMBRANT_N;
  16233. IMETHOD = TAB1.<METHODE_REMONTEE ;
  16234.  
  16235. RP = TAB1.<RP ;
  16236. HP = TAB1.<HP ;
  16237.  
  16238. SI (EXIS TAB1 <SAUV_PTS_OMBRANTS ) ;
  16239. REPO = TAB1.<SAUV_PTS_OMBRANTS ;
  16240. SINON ;
  16241. REPO = FAUX ;
  16242. FINSI ;
  16243.  
  16244. si (non (exis tab1 <reprise)) ;
  16245. tab1.<reprise = faux ;
  16246. finsi ;
  16247.  
  16248.  
  16249. * forcage du sens de remontee des linges de champ
  16250. * voir commentaire plus loin ou la notice
  16251. si (exis tab1 <chsignr1) ;
  16252. chsignr1 = tab1.<chsignr1 ;
  16253. finsi ;
  16254. *
  16255. * ------ verification de l'appartenance du maillage ombre ---------
  16256. * --------------- au domaine de validite de TOKAFLU ---------------
  16257. xm ym zm = coor mail1 ;
  16258. xg yg zg = @crmgc xm ym zm tab1 ;
  16259. rho theta phi = @crgtc xg yg zg rp hp ;
  16260. rhomax = maxi rho ;
  16261. rhomin = mini rho ;
  16262. thetamax = maxi theta ;
  16263. thetamin = mini theta ;
  16264. * RM 22/12/98 je desactive le test sur les angles
  16265. *si ((rhomax > 1.1) ou (rhomin < 0.4) ou
  16266. * (thetamax > 110.) ou (thetamin < -110.)) ;
  16267.  
  16268. si ((rhomax > 1.1) ou (rhomin < 0.4)) ;
  16269. ERRE ' >>>> @OMBRAGE : Le maillage ombre n est pas inclus dans le domaine de validite des modeles de @TOKAFLU';
  16270. finsi ;
  16271.  
  16272.  
  16273. * --- distance de remontee precedente en cas de reprise
  16274. si (tab1.<reprise) ;
  16275. d_prec = tab1.<LONGUEUR_REMONTEE ;
  16276. sinon ;
  16277. d_prec = 0. ;
  16278. finsi ;
  16279.  
  16280. DMAX2 = TAB1.<DIST_AVEC_TEST ;
  16281. PASB2 = TAB1.<PAS_AVEC_TEST ;
  16282.  
  16283. REPV = EXIS TAB1 <DIST_SANS_TEST ;
  16284. SI REPV ;
  16285. DMAX1 = TAB1.<DIST_SANS_TEST ;
  16286. PASB1 = TAB1.<PAS_SANS_TEST ;
  16287. FINSI ;
  16288. *
  16289. * --- Si le calcul est une reprise, on ne re-calcule pas CHSIGN1
  16290. *
  16291. si (non (tab1.<reprise));
  16292. * --- VARIABLES D'ENTREE, Valeurs par defaut
  16293. *
  16294. @VDEFAUT TAB1 ;
  16295. *
  16296. * ----
  16297. MESS '>@OMBRAGE> Construction du champoint B scalaire N';
  16298. *
  16299.  
  16300.  
  16301. * ---- Calcul du champ dans le repere global
  16302.  
  16303. * ---- coordonnees dans le repere du maillage
  16304. XM0 = COOR 1 GMAIL1 ;
  16305. YM0 = COOR 2 GMAIL1 ;
  16306. DIM0 = VALEUR DIME ;
  16307. SI (DIM0 EGA 2) ;
  16308. ZM0 = XM0 * 0. ;
  16309. BNUL = XM0 * 0. ;
  16310. SINON ;
  16311. ZM0 = COOR 3 GMAIL1 ;
  16312. FINSI ;
  16313.  
  16314.  
  16315. *---- Coordonnees dans le repere global du tore
  16316. XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
  16317.  
  16318.  
  16319. *
  16320. TYPCAL = TAB1.<TYPE_CALCUL ;
  16321. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  16322. ISHIFT = VRAI ;
  16323. IRIPPLE = VRAI ;
  16324. FINSI ;
  16325. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  16326. ISHIFT = VRAI ;
  16327. IRIPPLE = FAUX ;
  16328. FINSI ;
  16329. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  16330. ISHIFT = FAUX ;
  16331. IRIPPLE = VRAI ;
  16332. FINSI ;
  16333. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  16334. ISHIFT = FAUX ;
  16335. IRIPPLE = FAUX ;
  16336. FINSI ;
  16337. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  16338. ERRE '>@OMBRAGE> : check the value of TAB1.<TYPE_CALCUL';
  16339. FINSI ;
  16340.  
  16341.  
  16342. BXG BYG BZG FSECU = @CHAMB TAB1 XG_OLD YG_OLD ZG_OLD ISHIFT IRIPPLE ;
  16343. *---- composantes de B dans le repere du maillage
  16344. BXM BYM BZM = @CBGMV BXG BYG BZG TAB1 ;
  16345. *
  16346. *---- calcul des normales a la surface calculees
  16347. *---- dans le repere du maillage
  16348. si ((non (exis tab1 <nxm)) et ((nbno GMAIL1) ega (nbno MAIL1)));
  16349. MESS 'APPEL DE VNORM3D POUR LE MAILLAGE OMBRE';
  16350. NXM NYM NZM = @VNORM3D VMAIL1 GMAIL1 ;
  16351. tab1.<nxm = NXM ;
  16352. tab1.<nym = NYM ;
  16353. tab1.<nzm = NZM ;
  16354. sinon ;
  16355. NXM = tab1.<nxm ;
  16356. NYM = tab1.<nym ;
  16357. NZM = tab1.<nzm ;
  16358. finsi ;
  16359.  
  16360. *---- calcul du produit scalaire
  16361. PVBVN = (BXM*NXM) + (BYM*NYM) + (BZM*NZM);
  16362.  
  16363. CHSIGN0 = PVBVN / (ABS PVBVN) ;
  16364.  
  16365. *---- PROJECTION SUR LE MAILLAGE FIN INITIAL
  16366. *---- BOUCLE SUR CHAQUE POINT DU MAILLAGE FIN
  16367. MAILPT = CHAN MAIL1 POI1 ;
  16368. NBNFIN = NBNO MAIL1 ;
  16369. PT1 = ELEM MAILPT POINT 1 ;
  16370. PP = GMAIL1 POIN PROC PT1 ;
  16371. VAL1 = EXTR CHSIGN0 SCAL PP ;
  16372. MAILP1 = MANU POI1 PT1 ;
  16373. CHSIGN1 = MANU CHPO MAILP1 1 SCAL VAL1 'NATURE' DIFFUS ;
  16374. REPETER BOUPI (NBNFIN - 1) ;
  16375. I = &BOUPI + 1 ;
  16376. PTI = ELEM MAILPT POINT I ;
  16377. PPI = GMAIL1 POIN PROC PTI ;
  16378. VALI = EXTR CHSIGN0 SCAL PPI ;
  16379. MAILPI = MANU POI1 PTI ;
  16380. CHI = MANU CHPO MAILPI 1 SCAL VALI 'NATURE' DIFFUS ;
  16381. CHSIGN1 = CHSIGN1 ET CHI ;
  16382. FIN BOUPI ;
  16383.  
  16384. *---- Complement de TAB1.<CHSIGN1 sur les noeuds dont on veut remonter
  16385. *---- les lignes de champ
  16386. * ajout R. Mitteau le 13 mars 2001
  16387. * possibilite de definir soi-meme le chsign pour les noeuds
  16388. * dont on veut suivre la trajectoire
  16389. * on defini un tab1.chsign2, qu'on prend si il existe
  16390. si (exis tab1 <remontee) ;comm debut si sur point a remonter ;
  16391. si (exis tab1 <chsignr1) ;
  16392. chsign1 = chsign1 et chsignr1 ;
  16393. sinon ;
  16394. NPTS = DIME tab1 . <remontee . <point ;
  16395. REPETER BOUPTS1 NPTS ;
  16396. pt1 = tab1 . <remontee . <point . &BOUPTS1 ;
  16397. PP1 = MAIL1 POIN PROC PT1 ;
  16398. MAILP1 = MANU POI1 PT1 ;
  16399. VAL1 = EXTR CHSIGN1 SCAL PP1 ;
  16400. CH1 = MANU CHPO MAILP1 1 SCAL VAL1 'NATURE' DIFFUS ;
  16401. CHSIGN1 = CHSIGN1 ET CH1 ;
  16402. FIN BOUPTS1 ;
  16403. finsi ;
  16404. finsi ;comm fin si sur point a remonter ;
  16405. TAB1.<CHSIGN = CHSIGN1 ;
  16406. finsi ; comm refere au non tab1 reprise ;
  16407.  
  16408. * === NOMBRE DE PAS MAXIMUM A EFFECTUER PAR LA PROCEDURE
  16409. * RM310898 ruse pour ne pas avoir de pb avec les parties entieres
  16410. * apres constat comportement erratique
  16411.  
  16412. nbpas2 = ENTIER ((DMAX2 + (PASB2/1000.))/PASB2) ;
  16413. TAB1.<NBPAS2 = NBPAS2 ;
  16414. DMAX0 = (NBPAS2 * PASB2) + d_prec ;
  16415.  
  16416. si (exis tab1 <DIST_SANS_TEST) ;
  16417. nbpas1 = ENTIER ((DMAX1 + (PASB1/1000.))/PASB1) ;
  16418. TAB1.<NBPAS1 = NBPAS1 ;
  16419. DMAX0 = (NBPAS1 * PASB1) + (NBPAS2 * PASB2) + d_prec ;
  16420. finsi ;
  16421.  
  16422. *
  16423. * --- Choix du test d'intersection ANALYTIQUE (par defaut) ou GEOMETRIQUE
  16424. *
  16425. SI (NON (EXIS TAB1 <METHODE_INTERSECTION)) ;
  16426. TAB1.<METHODE_INTERSECTION = ANALYTIQUE ;
  16427. FINSI ;
  16428.  
  16429. *
  16430. * --- Appel de la procedure utiliant la methode analytique
  16431. *
  16432. SI (EGA TAB1.<METHODE_INTERSECTION ANALYTIQUE) ;
  16433. @ANALY TAB1 ;
  16434. FINSI ;
  16435. *
  16436.  
  16437.  
  16438. * --- Appel de la procedure utiliant la methode geometrique
  16439. *
  16440. SI (EGA TAB1.<METHODE_INTERSECTION GEOMETRIQUE) ;
  16441. CHDIST0 MAI1TRAV POMB = @TESTGEO TAB1 ;
  16442. TAB1.<CHDIST = CHDIST0;
  16443. TAB1.<MAI1TRAV = MAI1TRAV ;
  16444. FINSI ;
  16445.  
  16446. MESS '>@OMBRAG> - execution correcte' ;
  16447. MESS '>@OMBRAG> remontee en metre :' TAB1.<LONGUEUR_REMONTEE ;
  16448.  
  16449. SI (EGA (TAB1.<CONNEXION_MAX) 0.) ;
  16450. MESS ' ' ;
  16451. MESS '>@OMBRAGE> Pas d ombrage de OMBRE par OMBRANT';
  16452. MESS ' ' ;
  16453. SINON;
  16454. MESS '>@OMBRAG> mini - maxi de la longueur de connection' (mini TAB1.<CHDIST) TAB1.<CONNEXION_MAX ;
  16455. FINSI;
  16456.  
  16457. SI REPO ;
  16458. TAB1.<P_OMBRANTS = POMB ;
  16459. FINSI ;
  16460. * --------------- VARIABLES DE SORTIE GENERALES :
  16461. TAB1.<MASQOMB = MASQ TAB1.<CHDIST EGSUPE (DMAX0 - (PASB2/1000.)) ;
  16462. *------------------------------------
  16463.  
  16464. *
  16465. MESS '---------------------------------> exiting @OMBRAGE';
  16466. FINPROC ;
  16467. ***** OPIE
  16468. *********************************************************
  16469. ****** PROCEDURE IPOE ******
  16470. *********************************************************
  16471. * INTERPOLATION EN UTILISANT UNE EVOLUTION
  16472. *--------------------------------------------------------
  16473. DEBPROC OPIE OBJ_11/FLOTTANT OBJ_12/LISTREEL OBJ_13/CHPOINT EVO_1*EVOLUTION MO_1/MOT ;
  16474. *23456789012345678901234567890123456789012345678901234567890123456789012
  16475. * 1 2 3 4 5 6 7
  16476.  
  16477. LR_1 = EXTR EVO_1 'ABSC' 1 ;
  16478. LR_2 = EXTR EVO_1 'ORDO' 1 ;
  16479. IS1 = DIME LR_2 ;
  16480. LR_2B = ENLE LR_2 1 ;
  16481. LR_2A = ENLE LR_2 IS1 ;
  16482. IA1 = ( (LR_2B - LR_2A) MASQUE 'EGSUPE' 'SOMME' 0.) ;
  16483. II1 = ( (LR_2B - LR_2A) MASQUE 'EGINFE' 'SOMME' 0.) ;
  16484. IS2 = IS1 - 1 ;
  16485. SI ( IA1 EGA IS2 ) ;
  16486. LRE_2 = LR_1 ;
  16487. LRE_1 = LR_2 ;
  16488. A_1 = 1. ;
  16489. SINON ;
  16490. SI ( II1 EGA IS2 ) ;
  16491. A_1 = -1. ;
  16492. LRE_2 = LR_1 ;
  16493. LRE_1 = LR_2 * A_1 ;
  16494. SINON ;
  16495. MESS '>>>OPIE sorry your EVOL is not monotonous' ;
  16496. ERREUR '>>>OPIE sorry your EVOL is not monotonous' ;
  16497. FINSI ;
  16498. FINSI ;
  16499. SI ( NON (EXISTE MO_1)) ;
  16500. MO_2 = MOT 'SANS' ;
  16501. SINON ;
  16502. MO_2 = MO_1 ;
  16503. FINSI ;
  16504. SI (( EGA MO_2 'LINE' ) OU ( EGA MO_2 'FIXE' )) ;
  16505. SI ( EXISTE OBJ_11 ) ;
  16506. OBJ_2 = ITPLT LRE_1 LRE_2 MO_2 (OBJ_11 * A_1) ;
  16507. FINSI ;
  16508. SI ( EXISTE OBJ_12 ) ;
  16509. OBJ_2 = ITPLT LRE_1 LRE_2 MO_2 (OBJ_12 * A_1) ;
  16510. FINSI ;
  16511. SI ( EXISTE OBJ_13 ) ;
  16512. OBJ_2 = ITPLT LRE_1 LRE_2 MO_2 (OBJ_13 * A_1) ;
  16513. FINSI ;
  16514. SINON ;
  16515. SI ( EXISTE OBJ_11 ) ;
  16516. OBJ_2 = IPOL (OBJ_11 * A_1) LRE_1 LRE_2 ;
  16517. FINSI ;
  16518. SI ( EXISTE OBJ_12 ) ;
  16519. OBJ_2 = IPOL (OBJ_12 * A_1) LRE_1 LRE_2 ;
  16520. FINSI ;
  16521. SI ( EXISTE OBJ_13 ) ;
  16522. OBJ_2 = IPOL (OBJ_13 * A_1) LRE_1 LRE_2 ;
  16523. FINSI ;
  16524. FINSI ;
  16525. FINPROC OBJ_2 ;
  16526. *--------------------------------------------------------------------
  16527. **** ORTHO1
  16528. ********************
  16529. * PROCEDURE ORTHO1 *
  16530. ********************
  16531.  
  16532. DEBPROC ORTHO1 GEO1*MAILLAGE LIG1*MAILLAGE CH1*CHPOINT CH2*CHPOINT ALPHA*FLOTTANT LL*LISTREEL TYPEMAT*MOT TYPEELEM*LISTMOTS;
  16533.  
  16534. GEO = CHAN POI1 GEO1;
  16535. NEL1 = NBNO GEO;
  16536. DIMGEO = VALEUR DIME;
  16537. YOUNG11 = EXTR LL 1;
  16538. YOUNG22 = EXTR LL 2;
  16539. YOUNG33 = EXTR LL 3;
  16540. NU11 = EXTR LL 4;
  16541. NU22 = EXTR LL 5;
  16542. NU33 = EXTR LL 6;
  16543. CIS11 = EXTR LL 7;
  16544. CIS22 = EXTR LL 8;
  16545. CIS33 = EXTR LL 9;
  16546. ALPH11 = EXTR LL 10;
  16547. ALPH21 = EXTR LL 11;
  16548. ALPH31 = EXTR LL 12;
  16549. RHO = EXTR LL 13;
  16550.  
  16551. L1 = EXTR CH1 'COMP';
  16552. L2 = EXTR CH2 'COMP';
  16553.  
  16554. NBTYPE = DIME TYPEELEM;
  16555. NBCOMP = 0;
  16556. REPETER BOUCLNB NBTYPE;
  16557. NBCOMP = NBCOMP + 1;
  16558. TYPEN = EXTR TYPEELEM NBCOMP;
  16559. MODLNB = MODE GEO1 MECANIQUE ELASTIQUE ORTHOTROPE TYPEN ;
  16560. SI (NBCOMP EGA 1);
  16561. MODL1 = MODLNB;
  16562. SINON;
  16563. MODL1 = MODL1 ET MODLNB;
  16564. FINSI;
  16565. FIN BOUCLNB;
  16566.  
  16567. SI (DIMGEO EGA 3);
  16568. COMP = 0;
  16569. L11 = EXTR 1 L1;
  16570. L12 = EXTR 2 L1;
  16571. L13 = EXTR 3 L1;
  16572. L21 = EXTR 1 L2;
  16573. L22 = EXTR 2 L2;
  16574. L23 = EXTR 3 L2;
  16575. REPETER BOUCL1 NEL1;
  16576. COMP = COMP + 1;
  16577. POINMAIL = GEO POIN COMP;
  16578. POINCOUR = LIG1 POIN PROC POINMAIL;
  16579. CH1MAIL = MANU CHPO POINMAIL 3 KX (EXTR CH1 L11 POINCOUR) KY (EXTR CH1 L12 POINCOUR) KZ (EXTR CH1 L13 POINCOUR);
  16580. CH2MAIL = MANU CHPO POINMAIL 3 KX (EXTR CH2 L21 POINCOUR) KY (EXTR CH2 L22 POINCOUR) KZ (EXTR CH2 L23 POINCOUR);
  16581. SI (COMP EGA 1);
  16582. CH1GEO = CH1MAIL;
  16583. CH2GEO = CH2MAIL;
  16584. SINON;
  16585. CH1GEO = CH1GEO ET CH1MAIL;
  16586. CH2GEO = CH2GEO ET CH2MAIL;
  16587. FINSI;
  16588. FIN BOUCL1;
  16589.  
  16590. CH1 = ((COS ALPHA)*CH1GEO) + ((SIN ALPHA)*CH2GEO);
  16591. CH2 = (((-1.*(SIN ALPHA))*CH1GEO)) + ((COS ALPHA)*CH2GEO);
  16592.  
  16593. CHNEUTRE = (COOR 1 GEO1);
  16594. VRX = NOMC V1X (EXCO KX CH1);
  16595. VRY = NOMC V1Y (EXCO KY CH1);
  16596. VRZ = NOMC V1Z (EXCO KZ CH1);
  16597. VRX1 = CHAN CHAM VRX MODL1 RIGIDITE;
  16598. VRY1 = CHAN CHAM VRY MODL1 RIGIDITE;
  16599. VRZ1 = CHAN CHAM VRZ MODL1 RIGIDITE;
  16600. VZX = NOMC V2X (EXCO KX CH2);
  16601. VZY = NOMC V2Y (EXCO KY CH2);
  16602. VZZ = NOMC V2Z (EXCO KZ CH2);
  16603. VZX1 = CHAN CHAM VZX MODL1 RIGIDITE;
  16604. VZY1 = CHAN CHAM VZY MODL1 RIGIDITE;
  16605. VZZ1 = CHAN CHAM VZZ MODL1 RIGIDITE;
  16606. SINON;
  16607. COMP = 0;
  16608. L11 = EXTR 1 L1;
  16609. L12 = EXTR 2 L1;
  16610. L21 = EXTR 1 L2;
  16611. L22 = EXTR 2 L2;
  16612. REPETER BOUCL1 NEL1;
  16613. COMP = COMP + 1;
  16614. POINMAIL = GEO POIN COMP;
  16615. POINCOUR = LIG1 POIN PROC POINMAIL;
  16616. CH1MAIL = MANU CHPO POINMAIL 2 KX (EXTR CH1 L11 POINCOUR) KY (EXTR CH1 L12 POINCOUR);
  16617. CH2MAIL = MANU CHPO POINMAIL 2 KX (EXTR CH2 L21 POINCOUR) KY (EXTR CH2 L22 POINCOUR);
  16618. SI (COMP EGA 1);
  16619. CH1GEO = CH1MAIL;
  16620. CH2GEO = CH2MAIL;
  16621. SINON;
  16622. CH1GEO = CH1GEO ET CH1MAIL;
  16623. CH2GEO = CH2GEO ET CH2MAIL;
  16624. FINSI;
  16625. FIN BOUCL1;
  16626.  
  16627. CH1 = (CH1GEO*(COS ALPHA)) + (CH2GEO*(SIN ALPHA));
  16628. CH2 = ((CH1GEO*(-1.*(SIN ALPHA)))) + (CH2GEO*(COS ALPHA));
  16629.  
  16630. CHNEUTRE = (COOR 1 GEO1);
  16631. VRX = NOMC V1X (EXCO KX CH1);
  16632. VRY = NOMC V1Y (EXCO KY CH1);
  16633. VRX1 = CHAN CHAM VRX MODL1 RIGIDITE;
  16634. VRY1 = CHAN CHAM VRY MODL1 RIGIDITE;
  16635. VZX = NOMC V2X (EXCO KX CH2);
  16636. VZY = NOMC V2Y (EXCO KY CH2);
  16637. VZX1 = CHAN CHAM VZX MODL1 RIGIDITE;
  16638. VZY1 = CHAN CHAM VZY MODL1 RIGIDITE;
  16639.  
  16640. FINSI;
  16641.  
  16642. YOUNGR = ( CHNEUTRE * 0.) + YOUNG11;
  16643. YOUNGZ = ( CHNEUTRE * 0.) + YOUNG22;
  16644. YOUNGT = ( CHNEUTRE * 0.) + YOUNG33;
  16645. NURZ = ( CHNEUTRE * 0.) + NU11;
  16646. NUZT = ( CHNEUTRE * 0.) + NU22;
  16647. NURT = ( CHNEUTRE * 0.) + NU33;
  16648. CISRZ = ( CHNEUTRE * 0.) + CIS11;
  16649. CISZT = ( CHNEUTRE * 0.) + CIS22;
  16650. CISRT = ( CHNEUTRE * 0.) + CIS33;
  16651. ALPH12 = ( CHNEUTRE * 0.) + ALPH11;
  16652. ALPH22 = ( CHNEUTRE * 0.) + ALPH21;
  16653. ALPH32 = ( CHNEUTRE * 0.) + ALPH31;
  16654. RHO1 = ( CHNEUTRE * 0.) + RHO;
  16655.  
  16656. YOUNG1 = CHAN CHAM (NOMC YG1 YOUNGR) MODL1 RIGIDITE;
  16657. YOUNG2 = CHAN CHAM (NOMC YG2 YOUNGZ) MODL1 RIGIDITE;
  16658. YOUNG3 = CHAN CHAM (NOMC YG3 YOUNGT) MODL1 RIGIDITE;
  16659. NU1 = CHAN CHAM (NOMC NU12 NURZ) MODL1 RIGIDITE;
  16660. NU2 = CHAN CHAM (NOMC NU23 NUZT) MODL1 RIGIDITE;
  16661. NU3 = CHAN CHAM (NOMC NU13 NURT) MODL1 RIGIDITE;
  16662. CIS1 = CHAN CHAM (NOMC G12 CISRZ) MODL1 RIGIDITE;
  16663. CIS2 = CHAN CHAM (NOMC G23 CISZT) MODL1 RIGIDITE;
  16664. CIS3 = CHAN CHAM (NOMC G13 CISRT) MODL1 RIGIDITE;
  16665. ALPH1 = CHAN CHAM (NOMC ALP1 ALPH12) MODL1 RIGIDITE;
  16666. ALPH2 = CHAN CHAM (NOMC ALP2 ALPH22) MODL1 RIGIDITE;
  16667. ALPH3 = CHAN CHAM (NOMC ALP3 ALPH32) MODL1 RIGIDITE;
  16668. RHO = CHAN CHAM (NOMC 'RHO' RHO1) MODL1 RIGIDITE;
  16669.  
  16670. SI ((EGA TYPEMAT COMI) OU ( EGA TYPEMAT MABIPLAN));
  16671. MAT11 = YOUNG1 ET YOUNG2 ET NU1;
  16672. MAT22 = CIS1;
  16673. MAT33 = VRX1 et VRY1 et VZX1 et VZY1;
  16674. MAT44 = ALPH1 ET ALPH2 ET RHO;
  16675. FINSI;
  16676. SI ( EGA TYPEMAT COEP);
  16677. MAT11 = YOUNG1 ET YOUNG2 ET NU1;
  16678. MAT22 = CIS1 ET CIS2 ET CIS3;
  16679. MAT33 = VRX1 et VRY1 et VZX1 et VZY1;
  16680. MAT44 = ALPH1 ET ALPH2 ET RHO;
  16681. FINSI;
  16682. SI ( EGA TYPEMAT MABIAXI);
  16683. MAT11 = YOUNG1 ET YOUNG2 ET YOUNG3 ET NU1 ET NU2 ET NU3;
  16684. MAT22 = CIS1;
  16685. MAT33 = VRX1 et VRY1 et VRZ1 et VZX1 et VZY1 et VZZ1;
  16686. MAT44 = ALPH1 ET ALPH2 ET ALPH3 ET RHO;
  16687. FINSI ;
  16688. SI ( EGA TYPEMAT MABIFOU) ;
  16689. MAT11 = YOUNG1 ET YOUNG2 ET YOUNG3 ET NU1 ET NU2 ET NU3;
  16690. MAT22 = CIS1 ET CIS2 ET CIS3;
  16691. MAT33 = VRX1 et VRY1 et VZX1 et VZY1;
  16692. MAT44 = ALPH1 ET ALPH2 ET ALPH3 ET RHO;
  16693. FINSI;
  16694. SI ( EGA TYPEMAT MAS3D);
  16695. MAT11 = YOUNG1 ET YOUNG2 ET YOUNG3 ET NU1 ET NU2 ET NU3;
  16696. MAT22 = CIS1 ET CIS2 ET CIS3;
  16697. MAT33 = VRX1 et VRY1 et VRZ1 et VZX1 et VZY1 et VZZ1;
  16698. MAT44 = ALPH1 ET ALPH2 ET ALPH3 ET RHO;
  16699. FINSI;
  16700.  
  16701. MAT1 = MAT11 ET MAT22 ET MAT33 ET MAT44;
  16702. MATGEO = CHAN TYPE MAT1 CARACTERISTIQUES;
  16703.  
  16704. FINPROC MATGEO MODL1 ;
  16705.  
  16706.  
  16707. **** @PDROP
  16708. DEBPROC @PDROP TAB1*TABLE ;
  16709. *************************************************************************
  16710. * CALCUL CHUTE DE PRESSION *
  16711. *************************************************************************
  16712. *123456789012345678901234567890123456789012345678901234567890123456789012
  16713. * 1 2 3 4 5 6 7*
  16714. MESS ' ';
  16715. NIVEAU = TAB1 . 'NIVEAU';
  16716. *
  16717. SI (NIVEAU >EG 4) ;
  16718. MESS '---------------------------------> calling @PDROP';
  16719. FINSI ;
  16720. *
  16721. * entrees
  16722. *
  16723. DIAM = TAB1 . 'D_MAQUETTE' ;
  16724. VIT = TAB1 . 'V_IN' ;
  16725. TEAU = TAB1 . 'T_IN' ;
  16726. LMAQ = TAB1 . 'L_MAQUETTE' ;
  16727. LH = TAB1 . 'L_HEATED' ;
  16728. PIN = TAB1 . 'P_IN' ;
  16729. TAPE = TAB1 . 'T_TAPE' ;
  16730. YTW = TAB1 . 'TWIST_RATIO' ;
  16731. *
  16732. SI ( NON ( EXISTE TAB1 ORIGIN_LH)) ;
  16733. TAB1 . ORIGIN_LH = 0. ;
  16734. SI (NIVEAU >EG 2) ;
  16735. MESS '>@PDROP> ORIGIN_LH set to default value : 0';
  16736. FINSI ;
  16737. FINSI ;
  16738. ZLH = TAB1 . 'ORIGIN_LH' ;
  16739.  
  16740. PI = 3.14159 ;
  16741. *
  16742. *****************TABLE DE L EAU***************************************
  16743. *--- RHO de l eau en fonction de la temperature
  16744. PTRHO = PROG 0. 20. 40. 60. 80. 100. 120. 140. 160. 180. 200. 220. 240. 260. 280.6 300. ;
  16745. 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 ;
  16746. *--- VISCO de l eau en fonction de la temperature
  16747. PTNNU = PROG 0. 20. 40. 60. 80. 100. 120. 140. 160. 180. 200. 220. 240. 260. 280.6 300. ;
  16748. 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 ;
  16749. **********************************************************************
  16750. RHO_N = IPOL TEAU PTRHO PRHOF ;
  16751. N_NU = IPOL TEAU PTNNU PNNU ;
  16752. *
  16753. SI (YTW EGA 0.) ;
  16754. *
  16755. *---CANAL SANS SWIRL
  16756. DH = DIAM ;
  16757. VIT1 = VIT ;
  16758. SI ( EXISTE TAB1 RIP_FLOWS ) ;
  16759. S1 = ( TAB1 . RIP_FLOWS ) ;
  16760. FINSI ;
  16761. SI ( EXISTE TAB1 RIP_WETP ) ;
  16762. * PERI = ( TAB1 . RIP_WETP ) ;
  16763. * DH = 4. * S1 / PERI ;
  16764. DH = DIAM ;
  16765. FINSI ;
  16766. SI ( EXISTE TAB1 RIP_TWIST ) ;
  16767. PIS2Y = PI / ( 2. *( TAB1 . RIP_TWIST ) ) ;
  16768. FACV2 = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  16769. VIT1 = VIT * FACV2 ;
  16770. * FACV = MAXI ( PROG FACV FACV2 ) ;
  16771. FINSI ;
  16772. RE = VIT1 * DH / ( N_NU / RHO_N ) ;
  16773. MESS '>@PDROP> HYD. DIAM. :' DH ;
  16774. MESS '>@PDROP> VITESSE :' VIT1 ;
  16775. MESS '>@PDROP> REYNOLDS :' RE ;
  16776. * F_FRICT = TAB1.'LAMBDA' ;
  16777. * SI ( RE < 2.E4 ) ;
  16778. * MESS '>@PDROP> F_FRICT = 0.316 * ( RE ** -0.25 )' ;
  16779. * F_FRICT = 0.316 * ( RE ** -0.25 ) ;
  16780. * SINON ;
  16781. * MESS '>@PDROP> F_FRICT = 0.184 * ( RE ** -0.20 )' ;
  16782. * F_FRICT = 0.184 * ( RE ** -0.20 ) ;
  16783. * FINSI ;
  16784. * COEF = F_FRICT * LMAQ / DH ;
  16785. * PERT = RHO_N * (VIT ** 2.) /2. ;
  16786. SI ( EXISTE TAB1 'LAMBDA') ;
  16787. F_FRICT = TAB1.'LAMBDA' ;
  16788. MESS '>@PDROP> frict. fact. given:' F_FRICT ;
  16789. SINON ;
  16790. F_FRICT = (1.82*(LOG RE)/(LOG 10.) - 1.64) ** -2. ;
  16791. MESS '>@PDROP> F_FRICT=((1.82*(log10 RE)) - 1.64) ** -2.:' F_FRICT;
  16792. FINSI ;
  16793. DPRES = F_FRICT * LMAQ / DH * RHO_N * (VIT ** 2.) /2. ;
  16794.  
  16795. SINON ;
  16796. *
  16797. *--- CANAL AVEC SWIRL
  16798. QUASI = ((PI * DIAM * DIAM / 4.) - (TAPE * DIAM)) ;
  16799. PERII = ((PI * DIAM)+(2.*(DIAM - TAPE))) ;
  16800. DHI = 4. * QUASI / PERII ;
  16801. *
  16802. PYI = PI / (2. * YTW ) ;
  16803. F1 = (1.+( PYI ** 2. ))**(0.5) ;
  16804. RE = F1 * VIT * DHI / ( N_NU / RHO_N ) ;
  16805. MESS '>@PDROP> HYD. DIAM. :' DHI ;
  16806. MESS '>@PDROP> VITESSE LONG. :' VIT ;
  16807. MESS '>@PDROP> VITESSE UTILE :' (VIT * F1) ;
  16808. MESS '>@PDROP> REYNOLDS :' RE ;
  16809. KFRIC = 0.3 * ( RE ** -0.25 ) ;
  16810. *
  16811. * DPRI = 0.15 * ( DHI ** -1.25 ) * ((N_NU / RHO_N)**0.25)
  16812. * * ( F1 ** 2.75 ) ;
  16813. * DPRE = RHO_N * ( VIT ** 1.75 ) ;
  16814. * DPRES = DPRI * DPRE * LMAQ ;
  16815. *---facteur correctif
  16816. * AF = 1.46 ;
  16817. * BF = 10100 ;
  16818. * DPRES = (DPRES * AF) + BF ;
  16819. DPRES = 0.158 * ((N_NU / RHO_N)**0.25) * ( DHI ** -1.25 ) * ( F1 ** 2.84 ) * LMAQ * RHO_N * ( VIT ** 1.84 ) ;
  16820. *
  16821.  
  16822. FINSI ;
  16823. *
  16824. *---DIFFERENTES PRESSIONS DANS LA MAQUETTE
  16825. *
  16826. TAB1 . V_RHO_N = RHO_N ;
  16827. POUT = PIN - DPRES ;
  16828. PIN_LC = PIN - (DPRES * ZLH / LMAQ ) ;
  16829. POUT_LC = PIN - (DPRES * (ZLH + LH) / LMAQ ) ;
  16830. PRESMOY = (PIN_LC + POUT_LC) / 2. ;
  16831. *
  16832. MESS '>@PDROP> PIN :' PIN ;
  16833. MESS '>@PDROP> PIN HEATED LENGHT :' PIN_LC ;
  16834. MESS '>@PDROP> POUT HEATED LENGHT :' POUT_LC ;
  16835. MESS '>@PDROP> POUT :' POUT ;
  16836. MESS '>@PDROP> MEAN PRESS. :' PRESMOY ;
  16837. MESS '>@PDROP> DP :' DPRES ;
  16838. SI (NIVEAU >EG 4) ;
  16839. MESS '---------------------------------> exiting @PDROP';
  16840. FINSI ;
  16841. FINPROC DPRES PIN_LC POUT_LC POUT ;
  16842. **** @PPERM
  16843. DEBPROC @PPERM TAB1*'TABLE' ITE1/'ENTIER';
  16844. SI (NON (EXISTE TAB1 NISOV)) ;
  16845. TAB1.NISOV = 7 ;
  16846. FINSI ;
  16847. *23456789012345678901234567890123456789012345678901234567890123456789012
  16848. * 1 2 3 4 5 6 7
  16849. *
  16850. NIVEAU = TAB1.'NIVEAU' ;
  16851. SI (NIVEAU >EG 4) ;
  16852. MESS ' -------------------> calling @PPERM';
  16853. FINSI ;
  16854. MESS ' ';
  16855. MESS ' ';
  16856. MESS ' ######################################################### ';
  16857. MESS ' POST TRAITEMENT DES CALCULS THERMIQUES STATIONAIRES ';
  16858. MESS ' ######################################################### ';
  16859. MESS ' ';
  16860. MESS ' ';
  16861.  
  16862. * RM 07/03/97
  16863. * pb dans les legendes des traces : il faudrait faire le menage
  16864. *
  16865. *
  16866. *
  16867. *
  16868. *
  16869. *
  16870. *JS 11/1/95 TAB1.V_FACFM1 est utilise pour le calcul de la puissance
  16871. * donnee en commentaire sur les courbes
  16872. *le probleme est que dans le cas d un lambdaq TAB1.LIS_FLUX contient
  16873. * la liste des PHI0 a traiter et non le flux moyen commme dans le
  16874. * cas canon le plus simple serait peut etre d exiger LIS_PHI0
  16875. * et de CREER LIS_FLUMOYEN dans ce cas....
  16876. *
  16877. *
  16878. si (existe tab1 points) ;
  16879. ind1 = inde (tab1.points) ;
  16880. finsi ;
  16881. *
  16882. * INITIALISATION DES PROG
  16883. *
  16884. SI ((NON (EXISTE TAB1 GRAPH1)) OU (NON (EXISTE ITE1 )));
  16885. TAB1.GRAPH1 = TABLE;
  16886. TAB1.GRAPH1.LITICZ = PROG;
  16887. TAB1.GRAPH1.LITMCZ = PROG;
  16888. TAB1.GRAPH1.LITMP = PROG;
  16889. TAB1.GRAPH1.LIFLU = PROG;
  16890. TAB1.GRAPH1.LIFL = PROG;
  16891. TAB1.GRAPH1.LIFLUM = PROG;
  16892. TAB1.GRAPH1.FLUCRIT = PROG;
  16893. TAB1.GRAPH1.FLUCRITJB = PROG;
  16894. TAB1.GRAPH1.LIFLUEV = PROG;
  16895. TAB1.GRAPH1.LIFLUP = PROG;
  16896. TAB1.GRAPH1.LIFLUC = PROG;
  16897. TAB1.GRAPH1.LIFLUR = PROG;
  16898. TAB1.GRAPH1.L90PF = PROG;
  16899. TAB1.GRAPH1.L80PF = PROG;
  16900. TAB1.GRAPH1.L70PF = PROG;
  16901. TAB1.GRAPH1.POFLUC = PROG;
  16902. TAB1.GRAPH1.POFLUR = PROG;
  16903. IPP1 = 0 ;
  16904.  
  16905. si (existe tab1 li_point) ;
  16906. TAB1.LIS_TEMP = TABLE ;
  16907. REPETER BOUPO6 (DIME TAB1.LI_POINT);
  16908. IPP1 = IPP1 + 1 ;
  16909. TAB1.LIS_TEMP . IPP1 = PROG;
  16910. FIN BOUPO6;
  16911. finsi ;
  16912. si (existe tab1 points) ;
  16913. TAB1.LIS_TEMP = TABLE ;
  16914. TAB1.LIS_TEMP . 0 = PROG;
  16915. REPETER BOUPO6 ;
  16916. si (exis ind1 &BOUPO6) ;
  16917. TAB1.LIS_TEMP . &BOUPO6 = PROG;
  16918. sinon ;
  16919. quitter BOUPO6 ;
  16920. finsi ;
  16921. FIN BOUPO6;
  16922. finsi ;
  16923.  
  16924. SI ( EXISTE TAB1 EVEXP) ;
  16925. TAB2 = INDEX (TAB1.EVEXP) ;
  16926. IPP1 = 0 ;
  16927. TAB1.LIS_FPAROI = TABLE ;
  16928. TAB1.LIS_DTPAROI = TABLE ;
  16929. TAB1.LIS_DTEXP = TABLE ;
  16930. REPETER BOUPO7 (DIME TAB2) ;
  16931. IPP1 = IPP1 + 1;
  16932. TAB1.LIS_FPAROI . IPP1 = PROG ;
  16933. TAB1.LIS_DTPAROI . IPP1 = PROG ;
  16934. TAB1.LIS_DTEXP . IPP1 = PROG ;
  16935. FIN BOUPO7;
  16936. FINSI ;
  16937.  
  16938. FINSI;
  16939. SI (NON (EXISTE ITE1 ));
  16940. NN1 = DIME TAB1.LIS_FLUX ;
  16941. ITER = 0 ;
  16942. SINON ;
  16943. NN1 = 1 ;
  16944. ITER = ITE1 ;
  16945. FINSI;
  16946. SI (NON (EXISTE TAB1 LFLUX_CONV_DESS ));
  16947. TAB1.LFLUX_CONV_DESS = TAB1.LFLUX_CONV ;
  16948. FINSI;
  16949. *
  16950. * DEBUT DU POST TRAITEMENT : EXTRACTION DES 'T' ET 'H' -> TRACE ISOV.
  16951. *
  16952. *
  16953. COTETF1 = TAB1.C_COTETF1;
  16954. SITETF1 = TAB1.C_SITETF1;
  16955.  
  16956. COTETR1 = TAB1.C_COTETR1;
  16957. SITETR1 = TAB1.C_SITETR1;
  16958.  
  16959. COTETC1 = TAB1.C_COTETC1;
  16960. SITETC1 = TAB1.C_SITETC1;
  16961.  
  16962.  
  16963. S_TOT1 = TAB1.'M_ILLAGE_TOT';
  16964. C_ONT1 = TAB1.'M_IL_CONTOUR';
  16965.  
  16966. SI (EXISTE TAB1 'MAIL_TOT_DESS' );
  16967. S_TOT2 = TAB1.'MAIL_TOT_DESS';
  16968. C_ONT2 = TAB1.'MAIL_CONTOUR_DESS';
  16969. SINON ;
  16970. S_TOT2 = TAB1.'M_ILLAGE_TOT';
  16971. C_ONT2 = TAB1.'M_IL_CONTOUR';
  16972. FINSI ;
  16973.  
  16974. REPETER BOO1 NN1 ;
  16975.  
  16976. SI (NON (EXISTE ITE1 ));
  16977. ITER = ITER + 1 ;
  16978. FINSI ;
  16979. MESS ' ';
  16980. MESS '---------------------------------------';
  16981. MESS ' Exploitation of Step number ' ITER ;
  16982. MESS ' Heat flux [MW/m2] ' ((EXTR TAB1.LIS_FLUX ITER)/1.E6);
  16983. MESS ' ';
  16984.  
  16985. VFPAT1 = TAB1.V_VPAT1 * (EXTR TAB1.LIS_FLUX ITER);
  16986. * FLU1 est le flux moyen
  16987. SI ( EXISTE TAB1 'LAMDAQ' );
  16988. SI ( EXISTE TAB1 'V_FACFM1');
  16989. FLU1 = (EXTR TAB1.LIS_FLUX ITER) * TAB1.V_FACFM1 ;
  16990. SINON ;
  16991. FLU1 = (EXTR TAB1.LIS_FLUX ITER) * TAB1.'V_FACFM2';
  16992. FINSI ;
  16993. * FLU1 = (EXTR TAB1.LIS_FLUX ITER) * TAB1.V_FACFM1;
  16994. *js15.5.97* SI ( EXISTE TAB1 'CENTRE_PLASMA' );
  16995. *js15.5.97* PUI1 = FLU1 * (TAB1 . B_HEATED) * (TAB1.WE_HEATED );
  16996. *js15.5.97* SINON;
  16997. *js15.5.97* PUI1 = FLU1 * (TAB1 . L_HEATED) * (TAB1.WE_HEATED );
  16998. *js15.5.97* FINSI;
  16999. SINON;
  17000. FLU1 = (EXTR TAB1.LIS_FLUX ITER);
  17001. *js15.5.97* PUI1 = FLU1 * (TAB1 . L_HEATED) * (TAB1.W_HEATED );
  17002. TAB1 . WE_HEATED = TAB1 . W_HEATED;
  17003. FINSI;
  17004. PUI1 = RESU TAB1.I_FPAT1.ITER ;
  17005. *
  17006. MOTITR = TAB1.TITR_MAQ ;
  17007. TITRE MOTITR '- ISOV. T. VAL FLUX: ' FLU1 'VAL PUIW LIN MAIL :' PUI1;
  17008. *123456789012345678901234567890123456789012345678901234567890123456789012
  17009. TE1 = TAB1.ITER;
  17010. SI ( EXISTE TAB1 LIS_TPER );
  17011. III1 = EXTR TAB1.LIS_TPER ITER;
  17012. SINON;
  17013. III1 = FLOT ITER;
  17014. FINSI;
  17015. CHT1 = EXCO 'T' TE1;
  17016. *<JS deb
  17017. SI ( EGA ( TYPE ( TAB1.RESUTHER.'VALEUR_TETA'.ITER)) 'CHPOINT ');
  17018. V_TETA = EXCO 'T' ( TAB1.RESUTHER.'VALEUR_TETA'.ITER) ;
  17019. SINON ;
  17020. V_TETA = TAB1.RESUTHER.'VALEUR_TETA'.ITER;
  17021. FINSI ;
  17022. HCONVT1 = EXCO 'H' ( TAB1.RESUTHER.COEFECHANGE.ITER ) ;
  17023. HCONRT1 = EXCO 'H' ( TAB1.RESUTHER.COEFRAYONNE.ITER ) ;
  17024. *<JS fin
  17025. *
  17026. MESS ' MAXI MINI TEMPERATURES ' ( MAXI CHT1) ( MINI CHT1 ) ;
  17027. CHTI0 = ( REDU CHT1 TAB1.LFLUX_CONV ) ;
  17028. MACHTI0 = MAXI CHTI0 ;
  17029. MICHTI0 = MINI CHTI0 ;
  17030. CHTI2 = CHTI0 * 1.E5 ;
  17031. *<JS deb
  17032. CHTI1 = CHTI0 - V_TETA ;
  17033. FLH1 = FLUX (TAB1.'MODELV') ( HCONVT1 * -1. );
  17034. FLI1 = FLH1 * CHTI1 ;
  17035. FLI2 = HCONVT1 * CHTI1 ;
  17036. *<JS fin
  17037. *<JS>FLI2 = @IPOE CHTI0 TAB1.'EV_FLUX_CONV'.ITER ;
  17038. *<JS>FLI1 = FLUX (TAB1.'MODELV') (FLI2 * -1.);
  17039. MESS ' MAXI MINI TEMP. CONV ' ( MAXI CHTI0) ( MINI CHTI0) ;
  17040. *
  17041. CHTIR0 = ( REDU CHT1 (TAB1.LFLUX_RAYO) ) ;
  17042. CHTIR2 = CHTIR0 * 1.E5 ;
  17043. *<JS deb
  17044. CHTIR1 = CHTIR0 - TAB1.TEMP_RAYO;
  17045. FLHR1 = FLUX (TAB1.'MODELR') ( HCONRT1 * -1. );
  17046. FLIR1 = FLHR1 * CHTIR1;
  17047. FLIR2 = HCONRT1 * CHTIR1;
  17048. *<JS fin
  17049. *<JS>FLIR2 = @IPOE CHTIR0 TAB1.'EV_FLUX_RAYO'.ITER ;
  17050. *<JS>FLIR1 = FLUX (TAB1.'MODELR') ( FLIR2 * -1. );
  17051. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  17052. AMPLV1 = ( TAB1 . DH ) / (2. * TAB1.MAX_SOFL ) ;
  17053. SINON ;
  17054. AMPLV1 = ( TAB1 . D_MAQUETTE ) / (2. * TAB1.MAX_SOFL);
  17055. FINSI ;
  17056. CHPX = EXCO SCAL ( FLIR2 * ( COTETR1 ) ) UX;
  17057. CHPY = EXCO SCAL ( FLIR2 * ( SITETR1 ) ) UY;
  17058. CHPT = @ET CHPX CHPY;
  17059. SI( EGA 3 (VALE DIME));
  17060. C3TETR1 = TAB1.C_C3TETR1;
  17061. CHPZ = EXCO SCAL ( FLIR2 * ( C3TETR1 ) ) UZ;
  17062. CHPT = @ET CHPT CHPZ;
  17063. FINSI ;
  17064. CHPT = REDU CHPT S_TOT2 ;
  17065. TAB1. V_VEC33 = @VECADA CHPT AMPLV1 'ROUGE' ;
  17066. MESS ' MAXI MINI TEMP. RAYO ' ( MAXI CHTIR0) ( MINI CHTIR0) ;
  17067. *>MESS ' MAXI MINI DT RAYO ' ( MAXI CHTIR1) ( MINI CHTIR1) ;
  17068. *>MESS ' MAXI MINI H RAYO ' ( MAXI HCONRT1) ( MINI HCONRT1);
  17069. MESS ' MAXI MINI FLUX RAYO ' ( MAXI FLIR2) ( MINI FLIR2);
  17070. MESS ' MAXI MINI FLUX CONV ' ( MAXI FLI2 ) ( MINI FLI2 ) ;
  17071. *
  17072. *--- CREATION DES FLECHES (FLUX) :
  17073. *
  17074. CHPX = EXCO SCAL ( FLI2 * ( COTETC1 ) ) UX;
  17075. CHPY = EXCO SCAL ( FLI2 * ( SITETC1 ) ) UY;
  17076. CHPT = @ET CHPX CHPY;
  17077. SI( EGA 3 (VALE DIME));
  17078. C3TETC1 = TAB1.C_C3TETC1;
  17079. CHPZ = EXCO SCAL ( FLI2 * ( C3TETC1 ) ) UZ;
  17080. CHPT = @ET CHPT CHPZ;
  17081. FINSI ;
  17082. CHPT = REDU CHPT S_TOT2 ;
  17083. TAB1. V_VEC1 = @VECADA CHPT ( 1. * AMPLV1) 'ROUGE' ;
  17084.  
  17085. CHPX = EXCO SCAL ( VFPAT1 * ( COTETF1 ) ) UX ;
  17086. CHPY = EXCO SCAL ( VFPAT1 * ( SITETF1 ) ) UY ;
  17087. CHPT = (@ET CHPX CHPY );
  17088. SI( EGA 3 (VALE DIME));
  17089. C3TETF1 = TAB1.C_C3TETF1;
  17090. CHPZ = EXCO SCAL ( VFPAT1 * ( C3TETF1 ) ) UZ;
  17091. CHPT = @ET CHPT CHPZ;
  17092. FINSI ;
  17093. CHPT = REDU CHPT S_TOT2 ;
  17094. TAB1. V_VEC22 = @VECADA (-1. * CHPT) ( -1. * AMPLV1 ) 'VERT' ;
  17095.  
  17096. *
  17097. * --- TRACE DES ISOVALEURS ET DES FLUX
  17098. *
  17099. VEC_00 = TAB1.V_VEC22 ET TAB1.V_VEC1 ET TAB1.V_VEC33 ;
  17100. TE2 = REDU TAB1.ITER S_TOT2 ;
  17101. TRAC 'CACH' TAB1.VIEW_P TAB1.NISOV TE2 S_TOT2 VEC_00 C_ONT2;
  17102.  
  17103. SI ( EXISTE TAB1 VIEW_P2 );
  17104. TRAC CACH TAB1.VIEW_P2 TAB1.NISOV TE2 S_TOT2 C_ONT2 (VEC1 VEC22 VEC_33);
  17105. FINSI;
  17106.  
  17107. SI ( NON( EXISTE TAB1 TRAC_GRAD ) );
  17108. TAB1.TRAC_GRAD = FAUX;
  17109. FINSI;
  17110.  
  17111. SI TAB1.TRAC_GRAD;
  17112. MO_TOT = MODE S_TOT1 'THERMIQUE' 'ISOTROPE';
  17113. VEGRA1 = @VECGRAD MO_TOT TAB1.RESUTHER.CONDUCMAT.ITER TE1 AMPLV1 'ROUGE';
  17114. TRACER TAB1.VIEW_P CACH TE1 S_TOT1 C_ONT1 VEGRA1 ;
  17115. FINSI ;
  17116. *
  17117. *--- TRACE DES COURBES: 'H' 'TEMP. ET FLUX SUR PAROI'
  17118. *
  17119. *>MESS ' COEF ECH SUR LA PAROI ' ;
  17120. *>MESS ' MAXI MINI ' ( MAXI HCONVT1 ) ( MINI HCONVT1 ) ;
  17121. TAB1.'FLUPAROI' = FLI2 ;
  17122. MESS ' ';
  17123.  
  17124. SI ( NON ( EXISTE TAB1 COEF_ECH_V_ABS ) ) ;
  17125. TAB1.COEF_ECH_V_ABS = FAUX ;
  17126. FINSI ;
  17127.  
  17128. SI ( TAB1.COEF_ECH_V_ABS ) ;
  17129. *> TITRE ' WALL HEAT TRANSFER COEF. (MAXI : ' ( MAXI HCONVT1 ) ;
  17130. *> TAB1.EVHS = EVOL VERT 'CHPO' ( HCONVT1 ) SCAL TAB1.LFLUX_CONV_DESS ;
  17131. *> TAB1.CH_H = REDU HCONVT1 TAB1.LFLUX_CONV ;
  17132. *> DESSIN TAB1.EVHS YBOR 0. 3.e5 'MARQ CROI REGU' ;
  17133. FINSI ;
  17134. * fin jb
  17135. SI( EGA 3 (VALE DIME));
  17136. MESS '>>>> @PPERM>>>> ATTENTION EN 3D TAB1.LFLUX_CONV_DESS';
  17137. MESS '>>>> @PPERM>>>> doit etre une ligne de TAB1.LFLUX_CONV';
  17138. FINSI ;
  17139. * --- courbe 1 -> de temperature de la paroi fonction de l'abscisse
  17140. *TITRE ' TEMP. PAROI ' ;
  17141. FLI0 = MANU CHPO TAB1.LFLUX_CONV_DESS 1 'SCAL' 0. ;
  17142. *js EVCHTI21 = EVOL 'CHPO' CHTI2 SCAL TAB1.LFLUX_CONV_DESS ;
  17143. EVCHTI21 = EVOL ROUG 'CHPO' (@ET CHTI2 FLI0) SCAL TAB1.LFLUX_CONV_DESS ;
  17144. EVTPAROI = EVOL ROUG 'CHPO' (@ET CHTI0 FLI0) SCAL TAB1.LFLUX_CONV_DESS ;
  17145.  
  17146. * --- courbe 2 -> de l'evolution totale tonb
  17147. *TITRE MOTITR 'WALL FLUX AND TEMP. FLUX: ' FLU1;
  17148. PLINT11 = EXTR EVCHTI21 ABSC;
  17149. EVTONB1 = EVOL ROUG MANU PLINT11 (PROG (DIME PLINT11)*(TAB1.V_TONB * 1.E5));
  17150.  
  17151. * --- courbe 3 -> flux a la paroi fonction de l'abscisse
  17152. *TITRE ' FLUX PAROI ' ;
  17153. *js EVFLI11 = EVOL 'CHPO' FLI2 SCAL TAB1.LFLUX_CONV_DESS ;
  17154. FLI0 = MANU CHPO TAB1.LFLUX_CONV_DESS 1 'SCAL' 0. ;
  17155. EVFLI11 = EVOL VERT 'CHPO' (@ET FLI2 FLI0) SCAL TAB1.LFLUX_CONV_DESS ;
  17156. EVFPAROI = EVFLI11 ;
  17157.  
  17158. * --- courbe 4 -> Valeur demi du flux a la paroi
  17159. *TITRE ' DEMI FLUX PAROI ' ;
  17160. EVFL1S2 = EVOL VERT MANU PLINT11 (PROG (DIME PLINT11)*((MAXI FLI2) / 2.));
  17161.  
  17162.  
  17163. EVE_PREP = EVCHTI21 ET EVTONB1 ET EVFLI11 ET EVFL1S2 ;
  17164. EVE_PRJB = EVE_PREP ;
  17165. *
  17166. * --- préparation des légendes
  17167. *
  17168. * les temperatures ont des symboles ouverts
  17169. * les flux des symboles fermes
  17170. TAC2 = TABLE;
  17171. TAC2.TITRE = TABLE ;
  17172. TAC2.1 = 'MARQ CROI REGU' ; TAC2.TITRE.1 = 'WALL_TEMP' ;
  17173. TAC2.2 = 'MARQ ETOI REGU' ; TAC2.TITRE.2 = 'TONB' ;
  17174. TAC2.3 = 'MARQ LOSA REGU' ; TAC2.TITRE.3 = 'WALL_FLUX' ;
  17175. TAC2.4 = 'MARQ TRIB REGU' ; TAC2.TITRE.4 = 'HALF_FLUX' ;
  17176. TAC2.5 = 'MARQ CARR REGU' ; TAC2.TITRE.5 = 'TONG75' ;
  17177. * a ce niveau, t,tonb, Wallflux sont pret a etre traces
  17178. * traces des différents flux critiques demandés
  17179.  
  17180. LLL1 = MOTS 'CARR' 'TRIA' 'TRIB' 'CARR' 'TRIA' 'TRIB';
  17181. TITR 'FLUX AND TEMPERATURE WALL EVOLUTION';
  17182.  
  17183. I1 = 1 ;
  17184. REPETER BOUC6 (DIME TAB1.FLUX_CRITIQUE.ITER) ;
  17185. EVE_PREP = EVE_PREP ET (EVOL VERT MANU PLINT11 (PROG (DIME PLINT11)* (EXTR TAB1.FLUX_CRITIQUE.ITER I1 )));
  17186.  
  17187. SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'TONG 75') ;
  17188. VALTI1 = TAB1.M_TONG ;
  17189. FINSI ;
  17190. SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'BOWR') ;
  17191. VALTI1 = 'BOWRING72' ;
  17192. FINSI ;
  17193. SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'CELA') ;
  17194. VALTI1 = 'CELATA94' ;
  17195. FINSI ;
  17196.  
  17197. TAC2.(4 + I1) = CHAI 'MARQ ' (EXTR LLL1 I1) ' REGU TITRE ' VALTI1 ;
  17198. I1 = I1 + 1 ;
  17199. FIN BOUC6 ;
  17200. SI ( NON ( EXISTE TAB1 M_TONGJB ) ) ;
  17201. TAB1.M_TONGJB = FAUX ;
  17202. FINSI ;
  17203.  
  17204. SI TAB1.M_TONGJB ;
  17205. SI ((DIME TAB1.CHFCORRELATION) > 1) ;
  17206. ERRE 'trop de correlations : incompatible avec TAB1.M_TONGJB';
  17207. FINSI ;
  17208. EVCHF2 = EVOL JAUN MANU PLINT11 (PROG (DIME PLINT11) *(EXTR TAB1.FLUX_CRITIQUE.ITER 1)) ;
  17209. EVCHFJB = EVOL JAUN MANU PLINT11 (PROG (DIME PLINT11)*(TAB1.FLJB_CRI_TONG.ITER)) ;
  17210. TAC2.6 = 'MARQ CARR REGU TITRE 1.67*TONG75' ;
  17211. TAC2.7 = 'MARQ TRIB REGU TITRE TONG75 CHF' ;
  17212. DESSIN (EVE_PRJB ET EVCHF2 ET EVCHFJB) LEGE MIMA TAC2 ;
  17213. SINON ;
  17214. DESSIN EVE_PREP LEGE MIMA TAC2 ;
  17215. TAB1.EVE_PREP1 = EVE_PREP ;
  17216. FINSI ;
  17217. MESS ' TEMP MAXI SUR PAROI : ' MACHTI0 ;
  17218. MESS ' TEMP MINI SUR PAROI : ' MICHTI0 ;
  17219. SI (EXISTE TAB1 LO_FLUI) ;
  17220. SI TAB1.LO_FLUI;
  17221. TEX_1 = (REDU CHT1 (TAB1.LFLUX_EXTE_DESS ));
  17222. EVTEX1 = EVOL 'CHPO' (TEX_1 * 1.E4) 'SCAL' (TAB1.LFLUX_EXTE_DESS);
  17223. EVFLEX1 = EVOL 'CHPO' VFPAT1 'SCAL' (TAB1.LFLUX_EXTE_DESS);
  17224. TITRE 'INCIDENT FLUX AND TEMPERATURE ' FLU1;
  17225. TAC2.1 = 'MARQ CROI REGU TITRE INCIDENT_FLUX' ;
  17226. TAC2.3 = 'MARQ CARR REGU TITRE L_EXT_TEMP' ;
  17227. DESSIN (EVFLEX1 ET EVTEX1) LEGE MIMA TAC2 ;
  17228. FINSI ;
  17229. FINSI ;
  17230. *
  17231. * --- EXTRACTION DES TEMP. AUX PTS DESIRES
  17232. SI ( EXISTE TAB1 LI_POINT ) ;
  17233. *
  17234. * les 10 lignes suivantes sont assez délicates
  17235. * svp ne pas modifier sans l'avis de RM ou JS
  17236. *
  17237. IPP1 = 0;
  17238. REPETER BOUPO1 (DIME TAB1.LI_POINT) ;
  17239. IPP1 = IPP1 + 1;
  17240. T_P1 = 'TEXT' ('EXTR' IPP1 TAB1.LI_POINT);
  17241. *js cast95 n'accepte plus un text ds EXTR
  17242. *js donc on lui recree le point
  17243. T_P3 = S_TOT1 'POIN' 'PROC' (T_P1) ;
  17244. T_P2 = EXTR IPP1 TAB1.LI_POINT ;
  17245. * list (T_P1) ;
  17246. TMIP1 = EXTR TE1 'T' T_P3;
  17247. MESS ' TEMPERATURE ................... : ' TMIP1 'EN ' T_P2;
  17248. TAB1.LIS_TEMP . IPP1 = ( TAB1.LIS_TEMP . IPP1 ) ET ( PROG TMIP1 ) ;
  17249. FIN BOUPO1;
  17250. FINSI ;
  17251.  
  17252. * autre syntaxe pour le meme resultat, RM101098
  17253. si (existe tab1 points) ;
  17254. repe boupo7 ;
  17255. si (existe ind1 &boupo7) ;
  17256. nom1 = ind1.&boupo7 ;
  17257. poa1 = tab1.points.nom1 ;
  17258. IPP1 = &boupo7 ;
  17259. TMIP1 = EXTR TE1 'T' poa1;
  17260. MESS ' TEMPERATURE ................... : ' TMIP1 'EN ' nom1;
  17261. TAB1.LIS_TEMP . IPP1 = ( TAB1.LIS_TEMP . IPP1 ) ET ( PROG TMIP1 ) ;
  17262. sinon ;
  17263. quitter boupo7 ;
  17264. finsi ;
  17265. fin boupo7;
  17266. finsi ;
  17267.  
  17268. MESS ' ';
  17269. IPP1 = 0;
  17270. REPETER BOUMA1;
  17271. IPP1 = IPP1 + 1;
  17272. SI ( EXISTE (TAB1.ZONE_MAT) IPP1 ) ;
  17273. TMMA1 = MAXI ( REDU CHT1 (TAB1.ZONE_MAT.IPP1 ) );
  17274. TIMA1 = MINI ( REDU CHT1 (TAB1.ZONE_MAT.IPP1 ) );
  17275. *****MESS ' SWIRL TAPE THICKNESS (M) : ' TTAPE;
  17276. MESS ' TEMPERATURE MAXI............... : ' TMMA1 'MAT. ' (TAB1.NOM_MAT.IPP1 );
  17277. MESS ' TEMPERATURE MINI............... : ' TIMA1 'MAT. ' (TAB1.NOM_MAT.IPP1 );
  17278. SINON ;
  17279. QUITTER BOUMA1 ;
  17280. FINSI ;
  17281. FIN BOUMA1;
  17282.  
  17283. MESS ' ' ;
  17284. MESS 'densite de flux de chaleur (W/)' ;
  17285. MESS ' ' ;
  17286. MESS ' FLUX MOYEN .....................: ' FLU1;
  17287. FLUMAE = ( MAXI VFPAT1);
  17288. MESS ' FLUX MAXI ENTRANT...............: ' FLUMAE;
  17289. FLUMIE = ( MINI VFPAT1);
  17290. MESS ' FLUX MINI ENTRANT...............: ' FLUMIE;
  17291. FLUMAS = ( MAXI FLI2 );
  17292. MESS ' FLUX MAXI SORTIE ...............: ' FLUMAS;
  17293. FLUMIS = ( MINI FLI2 );
  17294. MESS ' FLUX MINI SORTIE ...............: ' FLUMIS;
  17295. RPAT1 = MAXI (RESU TAB1.I_FPAT1.ITER);
  17296. *js15.5.97*PRPAT1 = ((RPAT1 * (TAB1.FSYM_X)) * TAB1.L_HEATED);
  17297. PRPAT1 = RPAT1 ;
  17298. RLI1 = MAXI ( RESU FLI1);
  17299. *js15.5.97*PRLI1 = ((RLI1 * (TAB1.FSYM_X)) * TAB1.L_HEATED);
  17300. PRLI1 = RLI1 ;
  17301. ARLI1 = ABS PRLI1;
  17302. POULI1 = ( ARLI1 /PRPAT1 ) * 100.;
  17303. RLIR1 = MAXI (RESU FLIR1);
  17304. *js15.5.97*PRLIR1 = ((RLIR1 *(TAB1.FSYM_X)) * TAB1.L_HEATED);
  17305. PRLIR1 = RLIR1 ;
  17306. ARLIR1 = ABS PRLIR1;
  17307. POULIR1 = ( ARLIR1 /PRPAT1 ) * 100.;
  17308. ***MESS ' SWIRL TAPE THICKNESS (M) : ' TTAPE;
  17309. SI ( EXISTE TAB1 'LAMDAQ' );
  17310. MESS ' LONGUEUR DE DECROISSANCE : ' TAB1.'LAMDAQ' ;
  17311. MESS ' FLUX DEMANDE PHIO : ' (EXTR TAB1.LIS_FLUX ITER);
  17312. FINSI;
  17313. MESS ' ' ;
  17314. MESS 'en 2D puissance en Watts par metre de tube (W/m)' ;
  17315. MESS ' ' ;
  17316. MESS ' RESULTANTE FLUX INCIDENT : ' RPAT1 ;
  17317. MESS ' RESULTANTE FLUX DE CONVECTION : ' RLI1 ;
  17318. MESS ' RESULTANTE FLUX DE RAYONNEMENT : ' RLIR1 ;
  17319.  
  17320. MESS ' ' ;
  17321. MESS 'en 2D puissance en Watts par metre sur la maquette maillee(W/m)' ;
  17322. MESS ' ' ;
  17323. MESS ' PUISSANCE INCIDENTE : ' PRPAT1 ;
  17324. MESS ' PUISSANCE DANS L EAU : ' PRLI1 '(' POULI1 '%)' ;
  17325. MESS ' PUISSANCE RAYONNEE : ' PRLIR1 '(' POULIR1 '%)' ;
  17326. MESS ' BILAN THERMIQUE : ' (PRPAT1 + PRLI1 + PRLIR1 );
  17327. TICZ1 = MINI CHT1;
  17328. TAB1.GRAPH1.LITICZ = TAB1.GRAPH1.LITICZ ET (PROG TICZ1);
  17329. TAB1.GRAPH1.LITMP = TAB1.GRAPH1.LITMP ET (PROG MACHTI0);
  17330. * attention RLIR1 est negatif
  17331. *js15.5.97*FLU11 = FLU1 + (RLIR1 / TAB1.W_HEATED * TAB1 . FSYM_X);
  17332. FLU11 = FLU1 + (RLIR1 / (MESU TAB1.LFLUX_RAYO) ) ;
  17333. MENAGE;
  17334.  
  17335. SI ( EXISTE TAB1 EVEXP) ;
  17336. * TAB2 = INDEX TAB1.EVEXP ;
  17337. IPP1 = 0 ;
  17338. REPETER BOUPO2 (DIME TAB2) ;
  17339. IPP1 = IPP1 + 1;
  17340. * T_P1 = 'TEXT' ('EXTR' IPP1 TAB1.LI_THEB);
  17341. T_P1 = 'TEXT' TAB2.IPP1 ;
  17342. T_P3 = S_TOT1 'POIN' 'PROC' (T_P1) ;
  17343. * T_P4 = EXTR IPP1 TAB1.LI_THEB ;
  17344. T_P4 = TAB2.IPP1 ;
  17345. T_TH1 = EXTR TE1 'T' T_P3;
  17346. TEXP_TH1 = @IPOE TAB1.EVEXP.T_P4 FLU11 ;
  17347.  
  17348. SI (TEXP_TH1 < (TAB1.V_TONB + 1.) ) ;
  17349. QUITTER BOUPO2;
  17350. SINON;
  17351. DTEXP_T1 = T_TH1 - TEXP_TH1 ;
  17352. MESS ' TEMPERATURE DE TH..calcule..... : ' T_TH1 'EN ' T_P4;
  17353. MESS ' TEMPERATURE experimentale...... : ' TEXP_TH1;
  17354. XPAROI = OPIE EVTPAROI T_TH1 'FIXE' ;
  17355. MESS ' ABSCISSE CURV ...........XPAROI : ' XPAROI;
  17356. TPAROI = @IPOE EVTPAROI XPAROI 'FIXE' ;
  17357. DTSATP = TPAROI - TAB1.T_SAT ;
  17358. DTSATEXP = DTSATP - DTEXP_T1 ;
  17359. * FPAROI = @IPOE EVFPAROI XPAROI 'FIXE' ;
  17360. FPAROI = @IPOE TAB1.EVOFE1 TPAROI 'FIXE' ;
  17361. MESS ' TPAROI FPAROI ..................: ' TPAROI FPAROI;
  17362. FINSI ;
  17363. SI ( (DTSATP &lt;EG 0. ) OU (DTSATEXP &lt;EG 0. ) );
  17364. QUITTER BOUPO2;
  17365. SINON;
  17366.  
  17367. TAB1.LIS_DTPAROI . IPP1 = ( TAB1.LIS_DTPAROI . IPP1 ) ET ( PROG DTSATP);
  17368. TAB1.LIS_DTEXP . IPP1 = ( TAB1.LIS_DTEXP . IPP1 ) ET ( PROG DTSATEXP);
  17369. TAB1.LIS_FPAROI . IPP1 = ( TAB1.LIS_FPAROI . IPP1 ) ET ( PROG FPAROI ) ;
  17370. FINSI ;
  17371. FIN BOUPO2;
  17372. FINSI ;
  17373. SI ( NON (EXISTE TAB1 LCAPKPC)); TAB1.LCAPKPC = VRAI; FINSI;
  17374. SI TAB1.LCAPKPC;
  17375. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  17376. ALPF90 PF90 = @CAPKPC EVFLI11 .9 TAB1.DH FLU11 NIVEAU;
  17377. ALPF80 PF80 = @CAPKPC EVFLI11 .8 TAB1.DH FLU11 NIVEAU;
  17378. ALPF70 PF70 = @CAPKPC EVFLI11 .7 TAB1.DH FLU11 NIVEAU;
  17379. SINON ;
  17380. ALPF90 PF90 = @CAPKPC EVFLI11 .9 TAB1.D_MAQUETTE FLU11 NIVEAU;
  17381. ALPF80 PF80 = @CAPKPC EVFLI11 .8 TAB1.D_MAQUETTE FLU11 NIVEAU;
  17382. ALPF70 PF70 = @CAPKPC EVFLI11 .7 TAB1.D_MAQUETTE FLU11 NIVEAU;
  17383. FINSI ;
  17384. TAB1.GRAPH1.L90PF = TAB1.GRAPH1.L90PF ET (PROG PF90);
  17385. TAB1.GRAPH1.L80PF = TAB1.GRAPH1.L80PF ET (PROG PF80);
  17386. TAB1.GRAPH1.L70PF = TAB1.GRAPH1.L70PF ET (PROG PF70);
  17387. FINSI ;
  17388.  
  17389. TAB1.GRAPH1.LIFL = TAB1.GRAPH1.LIFL ET (PROG FLU1);
  17390. TAB1.GRAPH1.LIFLU = TAB1.GRAPH1.LIFLU ET (PROG FLU11);
  17391. TAB1.GRAPH1.LIFLUM = TAB1.GRAPH1.LIFLUM ET (PROG FLUMAS);
  17392.  
  17393. TAB1.GRAPH1.FLUCRIT = TAB1.GRAPH1.FLUCRIT ET (PROG (EXTR TAB1.FLUX_CRITIQUE.ITER 1));
  17394. *jb
  17395. SI TAB1.M_TONGJB ;
  17396. TAB1.GRAPH1.FLUCRITJB = TAB1.GRAPH1.FLUCRITJB ET (PROG (EXTR TAB1.FLUX_CRITIQUE.ITER 1));
  17397. FINSI ;
  17398. *jb
  17399. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  17400. FLUEVAL = (FLU11 * (TAB1.W_HEATED) / TAB1.DH ) ;
  17401. SINON ;
  17402. FLUEVAL = (FLU11 * (TAB1.W_HEATED) / TAB1.D_MAQUETTE);
  17403. FINSI ;
  17404. TAB1.GRAPH1.LIFLUEV = TAB1.GRAPH1.LIFLUEV ET ( PROG FLUEVAL );
  17405. TAB1.GRAPH1.LIFLUP = TAB1.GRAPH1.LIFLUP ET ( PROG PRPAT1 );
  17406. TMCZ1 = MAXI CHT1;
  17407. TAB1.GRAPH1.LITMCZ = TAB1.GRAPH1.LITMCZ ET ( PROG TMCZ1);
  17408. TAB1.GRAPH1.LIFLUC = TAB1.GRAPH1.LIFLUC ET ( PROG ARLI1);
  17409. TAB1.GRAPH1.LIFLUR = TAB1.GRAPH1.LIFLUR ET ( PROG ARLIR1);
  17410. TAB1.GRAPH1.POFLUC = TAB1.GRAPH1.POFLUC ET ( PROG POULI1);
  17411. TAB1.GRAPH1.POFLUR = TAB1.GRAPH1.POFLUR ET ( PROG POULIR1);
  17412. *
  17413.  
  17414. FIN BOO1 ;
  17415.  
  17416. * Traces pour la derniere iteration
  17417. *
  17418. SI (EGA (DIME TAB1.LIS_FLUX) ITER);
  17419. *--- TRACE DES COURBES
  17420. *--- TEMP. DES PTS EN FCT DU FLUX INCIDENT CORRIGE ou reel
  17421. *
  17422. * SI ( NON ( EXISTE TAB1 PFLUXNCORR )) ;
  17423. TAB1 .PFLUXNCORR = VRAI ;
  17424. * FINSI ;
  17425. SI ( TAB1 .PFLUXNCORR ) ;
  17426. MOTFLU = 'INCIDENT FLUX ' ;
  17427. LLLFLU = TAB1.GRAPH1.LIFL ;
  17428. SINON ;
  17429. MOTFLU = 'ENTERING FLUX ' ;
  17430. LLLFLU = TAB1.GRAPH1.LIFLU ;
  17431. FINSI ;
  17432. TITRE 'SECTION TMIN CALCULATION';
  17433. EVTIC = EVOL MANU MOTFLU LLLFLU 'TEMPERATURE' TAB1.GRAPH1.LITICZ;
  17434. TITRE ' WALL TMAX CALCULATION ' ;
  17435. EVTIP = EVOL MANU MOTFLU LLLFLU 'TEMPERATURE' TAB1.GRAPH1.LITMP ;
  17436.  
  17437. 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';
  17438. *
  17439. * --- Tracés de T en fonction du flux
  17440. *
  17441.  
  17442. EVTTTS1 = EVOL MANU ( PROG 0. ) ( PROG 0.) ;
  17443. MESS ' >>>@PPERM>>>> 5.0 ' ;
  17444. *
  17445. * --- boucle sur les points
  17446. *
  17447. TAC1 = TABLE ;
  17448. TAC1.TITRE = TABLE ;
  17449. IPP1 = 0 ;
  17450.  
  17451. si (existe TAB1 LI_POINT);
  17452. REPETER BOUPO5 (DIME TAB1.LI_POINT);
  17453. IPP1 = IPP1 + 1 ;
  17454. T_P1 = TEXT (EXTR IPP1 TAB1.LI_POINT);
  17455. T_P2 = EXTR IPP1 TAB1.LI_POINT;
  17456. *jb : 5 10 94 possibilite d'afficher la profondeur des TC
  17457. SI ( NON ( EXISTE TAB1 DEEPCA )) ;
  17458. TAB1.DEEPCA = FAUX ;
  17459. FINSI ;
  17460. SI TAB1.DEEPCA ;
  17461. D_TC = EXTR IPP1 TAB1.DEEPCALC ;
  17462. TITR 'C' T_P2 D_TC 'm' ;
  17463. SINON ;
  17464. TITR T_P2 'CALCULATION';
  17465. FINSI ;
  17466. *
  17467. SI ( IPP1 EGA 1 ) ;
  17468. EVTTTS1 = ( EVOL MANU MOTFLU LLLFLU 'TEMPERATURE' TAB1.LIS_TEMP.IPP1 );
  17469. SINON ;
  17470. EVTTTS1 = EVTTTS1 ET ( EVOL MANU MOTFLU LLLFLU 'TEMPERATURE' TAB1.LIS_TEMP.IPP1);
  17471. FINSI;
  17472. * TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1)' REGU ';
  17473. TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1);
  17474. FIN BOUPO5 ;
  17475. finsi ;
  17476. si (existe TAB1 POINTS);
  17477. REPETER BOUPO5 ;
  17478. IPP1 = IPP1 + 1 ;
  17479. si (existe ind1 &boupo5) ;
  17480. nom1 = ind1.&boupo5 ;
  17481. poa1 = tab1.points.nom1 ;
  17482. IPP1 = &boupo5 ;
  17483. SI ( NON ( EXISTE TAB1 DEEPCA )) ;
  17484. TAB1.DEEPCA = FAUX ;
  17485. FINSI ;
  17486. SI TAB1.DEEPCA ;
  17487. D_TC = EXTR IPP1 TAB1.DEEPCALC ;
  17488. TITR 'C' nom1 D_TC 'm' ;
  17489. SINON ;
  17490. TITR nom1 'CALCULATION';
  17491. FINSI ;
  17492. *
  17493. SI ( IPP1 EGA 1 ) ;
  17494. EVTTTS1 = ( EVOL MANU MOTFLU LLLFLU 'TEMPERATURE' TAB1.LIS_TEMP.IPP1 );
  17495. SINON ;
  17496. EVTTTS1 = EVTTTS1 ET ( EVOL MANU MOTFLU LLLFLU 'TEMPERATURE' TAB1.LIS_TEMP.IPP1);
  17497. FINSI;
  17498. TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1) ;
  17499. TAC1.TITRE.IPP1 = nom1 ;
  17500. sinon ;
  17501. quitter BOUPO5 ;
  17502. finsi ;
  17503. FIN BOUPO5 ;
  17504. finsi ;
  17505.  
  17506.  
  17507.  
  17508. IPP1 = IPP1 + 1;
  17509.  
  17510.  
  17511.  
  17512. TITR 'CALCUL SECTION TMAX' ;
  17513. EVTMCZ = EVOL MANU MOTFLU LLLFLU 'TEMPERATURE' TAB1.GRAPH1.LITMCZ ;
  17514. * TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1)
  17515. * ' REGU' ;
  17516. TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1) ;
  17517.  
  17518. MOTITR = TAB1.TITR_MAQ ;
  17519. TITRE MOTITR 'T-LOCAL' (TAB1.'T_LOCAL') 'V-LOCAL' (TAB1.'V_LOCAL') 'P-LOCAL' (TAB1.'P_LOCAL');
  17520. EVTTTS1 = EVTTTS1 ET EVTMCZ;
  17521. SI ((DIME TAB1.LIS_FLUX) >EG 2);
  17522.  
  17523. SI ( EXISTE TAB1 EVOTEST) ;
  17524. EVTTT = ( EVTTTS1 ET (TAB1 . EVOTEST) ) ;
  17525. REPETER BOUTA1 (DIME (TAB1 . EVOTEST) ) ;
  17526. IPP1 = IPP1 + 1;
  17527. TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1) ' NOLI' ;
  17528. FIN BOUTA1;
  17529. SINON ;
  17530. EVTTT = EVTTTS1 ;
  17531. FINSI ;
  17532. TAB1.EVORESU = EVTTTS1 ;
  17533. TAB1.EVTTT1 = EVTTT ;
  17534. DESSIN EVTTT LEGE MIMA TAC1 ;
  17535. *
  17536. * --- autres tracés
  17537. *
  17538. TAC1 = TABLE ;
  17539. TAC1.TITRE = TABLE ;
  17540. IPP1 = 0 ;
  17541. SI ( EXISTE TAB1 EVEXP);
  17542. * TAB2 = INDEX TAB1.EVEXP ;
  17543. REPETER BOUPO8 (DIME TAB2);
  17544. IPP1 = IPP1 + 1 ;
  17545. * T_P2 = EXTR IPP1 TAB1.LI_THEB;
  17546. T_P2 = TAB2.IPP1 ;
  17547. TITRE TAB1.TITR_MAQ 'CORRELATION' TAB1.L_SUBNB ;
  17548. SI ( (DIME TAB1.LIS_FPAROI.IPP1) > 0);
  17549. II1 = 2*IPP1 - 1;
  17550. TAC1.II1 = CHAIN 'MARQ ' (EXTR L_SIGN1 II1) ' NOLI';
  17551. TAC1.TITRE.II1 = T_P2 'CALCULATION' ;
  17552. II1 = 2*IPP1 ;
  17553. TAC1.II1 = CHAIN 'MARQ ' (EXTR L_SIGN1 II1) ' NOLI';
  17554. TAC1.TITRE.II1 = T_P2 'EXP.' ;
  17555. SI ( IPP1 EGA 1 ) ;
  17556.  
  17557. EVDTFPA1 = ( 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. SINON ;
  17560. EVDTFPA1 = EVDTFPA1 ET ( EVOL MANU 'DTSAT' TAB1.LIS_DTPAROI.IPP1 'WALL_FLUX' TAB1.LIS_FPAROI . IPP1 ) ;
  17561. EVDTFPA1 = EVDTFPA1 ET ( EVOL MANU 'DTSAT' TAB1.LIS_DTEXP.IPP1 'WALL_FLUX' TAB1.LIS_FPAROI . IPP1 ) ;
  17562. FINSI;
  17563. FINSI;
  17564. FIN BOUPO8 ;
  17565. list EVDTFPA1 ;
  17566. TITRE ' WALL_FLUX VERSUS DT_SAT' ;
  17567. DESS EVDTFPA1 LOGX LOGY LEGE MIMA TAC1 ;
  17568. FINSI ;
  17569. TAC3 = TABLE;
  17570. TAC3.1 = 'MARQ PLUS ' ;
  17571. TAC3.2 = 'MARQ ETOI ' ;
  17572. TAC3.3 = 'MARQ CROI ' ;
  17573. TITRE 'INC. POWER ';
  17574. EVPUII = EVOL MANU TAB1.GRAPH1.LIFL TAB1.GRAPH1.LIFLUP ;
  17575. TITRE 'CONVECTIVE POWER';
  17576. EVPUIC = EVOL MANU 'INC FLUX ' TAB1.GRAPH1.LIFL 'PUIS CONV ' TAB1.GRAPH1.LIFLUC ;
  17577. EVPOUIC = EVOL MANU 'INC FLUX ' TAB1.GRAPH1.LIFL '% PUIS CONV ' TAB1.GRAPH1.POFLUC ;
  17578. TITRE 'RADIATIVE POWER';
  17579. EVPUIR = EVOL MANU 'INC FLUX' TAB1.GRAPH1.LIFL 'PUIS RAYO ' TAB1.GRAPH1.LIFLUR ;
  17580. EVPOUIR = EVOL MANU 'INC FLUX' TAB1.GRAPH1.LIFL '% PUIS RAYO ' TAB1.GRAPH1.POFLUR ;
  17581. TITRE 'REPARTITION DES PUISSANCES ';
  17582. EVPUIS = (EVPUII ET EVPUIC ET EVPUIR) ;
  17583. DESSIN EVPUIS LEGE MIMA TAC3 ;
  17584. TITRE 'REPARTITION DES PUISSANCES EN %';
  17585. EVPOUIS = (EVPOUIC ET EVPOUIR) ;
  17586. DESSIN EVPOUIS LEGE MIMA TAC3 ;
  17587. *
  17588. TITRE 'CALC. WALL MAX FLUX';
  17589. EVFLUPAR = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'WALL FLUX' TAB1.GRAPH1.LIFLUM ;
  17590. TITRE 'EV.WALL FLUX(Fi*W/D)';
  17591. EVFLUEV = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'WALL FLUX' TAB1.GRAPH1.LIFLUEV ;
  17592. ICHOI = EXTR TAB1.'CHFCORRELATION' 1 ;
  17593. SI ( EGA ICHOI 'TONG' ) ;
  17594. TITRE TAB1. M_TONG ;
  17595. FINSI ;
  17596. SI ( EGA ICHOI 'CELA' ) ;
  17597. TITRE 'CELATA 94' ;
  17598. FINSI ;
  17599. EVFLCRIT = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'WALL FLUX' TAB1.GRAPH1.FLUCRIT ;
  17600. *jb
  17601. SI TAB1.M_TONGJB ;
  17602. TITRE '1.67*TONG75 CHF ';
  17603. EVFLCRIT = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFLU 'WALL FLUX' TAB1.GRAPH1.FLUCRIT ;
  17604. TITRE (CHAIN (EXTR TAB1.CHFCORRELATION 1) ' CHF ');
  17605. EVFLJB = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFLU 'WALL. FLUX' TAB1.GRAPH1.FLUCRITJB ;
  17606. FINSI ;
  17607. *
  17608. TITRE 'TEST CHF ';
  17609. SI ( EXISTE TAB1 EVOTEST ) ;
  17610. M_FIESS = MAXI ( TAB1.EVOTEST EXTR 'ABSC' ) ;
  17611. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  17612. M_FWESS = M_FIESS * (TAB1.W_HEATED) / TAB1.DH ;
  17613. SINON ;
  17614. M_FWESS = M_FIESS * (TAB1.W_HEATED) / TAB1.D_MAQUETTE ;
  17615. FINSI ;
  17616. EVFCESS = EVOL MANU 'INC. FLUX' ( PROG M_FIESS ) 'WALL FLUX' ( PROG M_FWESS ) ;
  17617. TITRE MOTITR 'T-LOCAL' (TAB1.'T_LOCAL') 'V-LOCAL' (TAB1.'V_LOCAL') 'P-LOCAL' (TAB1.'P_LOCAL');
  17618.  
  17619.  
  17620. TAC3.4 = 'MARQ TRIB REGU' ;
  17621. *jb
  17622. SI TAB1.M_TONGJB ;
  17623. TAC3.5 = 'MARQ CARR NOLI' ;
  17624. DESSIN ( EVFLUPAR ET EVFLUEV ET EVFLJB ET EVFLCRIT ET EVFCESS )LEGE MIMA TAC3 ;
  17625. *jb
  17626. TAB1.EVFLUPA1 = EVFLUPAR ;
  17627. TAB1.EVFLUE1 = EVFLUEV ;
  17628. TAB1.EVFLJ1 = EVFLJB ;
  17629. TAB1.EVFLCRI1 = EVFLCRIT ;
  17630. TAB1.EVFCES1 = EVFCESS ;
  17631. SINON ;
  17632. DESSIN (EVFLUPAR ET EVFLUEV ET EVFLCRIT ET EVFCESS) LEGE MIMA TAC3 ;
  17633. TAB1.EVFLUPA1 = EVFLUPAR ;
  17634. TAB1.EVFLUE1 = EVFLUEV ;
  17635. TAB1.EVFLCRI1 = EVFLCRIT ;
  17636. TAB1.EVFCES1 = EVFCESS ;
  17637. FINSI ;
  17638. SINON ;
  17639. SI TAB1.M_TONGJB ;
  17640. DESSIN ( EVFLUPAR ET EVFLUEV ET EVFLJB ET EVFLCRIT ET EVFCESS )LEGE MIMA TAC3 ;
  17641. TAB1.EVFLUPA1 = EVFLUPAR ;
  17642. TAB1.EVFLUE1 = EVFLUEV ;
  17643. TAB1.EVFLJ1 = EVFLJB ;
  17644. TAB1.EVFLCRI1 = EVFLCRIT ;
  17645. TAB1.EVFCES1 = EVFCESS ;
  17646. SINON;
  17647. DESSIN ( EVFLUPAR ET EVFLUEV ET EVFLCRIT ) LEGE MIMA TAC3 ;
  17648. TAB1.EVFLUPA1 = EVFLUPAR ;
  17649. TAB1.EVFLUE1 = EVFLUEV ;
  17650. TAB1.EVFLCRI1 = EVFLCRIT ;
  17651. TAB1.EVFCES1 = EVFCESS ;
  17652. FINSI ;
  17653. FINSI ;
  17654. TITRE 'W/D P.F.';
  17655. TAC3.1 = 'MARQ PLUS ' ;
  17656. TAC3.2 = 'MARQ ETOI ' ;
  17657. TAC3.3 = 'MARQ CROI ' ;
  17658. TAC3.4 = 'MARQ TRIA ' ;
  17659. TAC3.5 = 'MARQ TRIB ' ;
  17660.  
  17661. EGEOPF = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'PEAKING_FACTOR' (TAB1.GRAPH1.LIFLUEV / TAB1.GRAPH1.LIFLU);
  17662. TITRE 'MAX FE P.F.';
  17663. EMEFPF = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'PEAKING_FACTOR' (TAB1.GRAPH1.LIFLUM / TAB1.GRAPH1.LIFLU);
  17664. TAB1.FE_PF = EMEFPF ;
  17665. SI TAB1.LCAPKPC;
  17666. TITRE '90% FE P.F.';
  17667. E90PF = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'PEAKING_FACTOR' TAB1.GRAPH1.L90PF;
  17668. TITRE '80% FE P.F.';
  17669. E80PF = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'PEAKING_FACTOR' TAB1.GRAPH1.L80PF;
  17670. TITRE '70% FE P.F.';
  17671. E70PF = EVOL MANU 'INC. FLUX' TAB1.GRAPH1.LIFL 'PEAKING_FACTOR' TAB1.GRAPH1.L70PF;
  17672. TITRE MOTITR 'T-LOCAL' (TAB1.'T_LOCAL') 'V-LOCAL' (TAB1.'V_LOCAL') 'P-LOCAL' (TAB1.'P_LOCAL');
  17673. DESSIN (E70PF ET E80PF ET E90PF ET EMEFPF ET EGEOPF) LEGE MIMA TAC3;
  17674. SINON ;
  17675. DESSIN ( EMEFPF ET EGEOPF) LEGE MIMA TAC3;
  17676. FINSI ;
  17677. *jb
  17678. TAB1.EMEFP1 = EMEFPF ;
  17679. TAB1.EGEOP1 = EGEOPF ;
  17680. FINSI ;
  17681. FINSI ;
  17682. TAB1.PPRLI1 = PRLI1 ;
  17683. MENAGE;
  17684. SI (NIVEAU >EG 4) ;
  17685. MESS ' -------------------> exiting @PPERM';
  17686. FINSI ;
  17687. FINPROC;
  17688. DEBPROC PRINRAPH CONTR1*MCHAML MOD1*MMODEL MAIL1/MAILLAGE ;
  17689.  
  17690. MESS '-----------------------------------> entree dans PRINRAPH ' ;
  17691. * modifier de maniere a pouvoir entre en option
  17692. *- le maillage sur lequel on veut les contraintes principales
  17693. *- le maillage sur lequel on veut que seffectue le trace
  17694. *
  17695. *
  17696.  
  17697. DIM1 = VALEUR DIME ;
  17698. * test sur la dimension
  17699. SI (EGA DIM1 2) ;
  17700. ;
  17701. SINON ;
  17702. ERRE 'PRIN RAPH NE MARCHE QUE EN 2D';
  17703. FINSI;
  17704.  
  17705.  
  17706.  
  17707.  
  17708.  
  17709. * de toute facon, il faut depouiller objet modele apres objet modele
  17710. * sinon, plusieurs contraintes principales n'ont pas de sens.
  17711.  
  17712. CONTR2 = REDU CONTR1 MOD1 ;
  17713. CONTR1 = CONTR2 ;
  17714. CPRIN1 = PRIN CONTR1 MOD1 ;
  17715. STOT1 = EXTR MOD1 'MAIL' ;
  17716. * on peut depouiller en modulant la taille du vecteur par
  17717. * le module de la contrainte principale associee
  17718.  
  17719. *----------1
  17720. * on extrait les composantes de module et de cos directeurs
  17721. CHSI11 = EXCO CPRIN1 SI11 ;
  17722. CHCOX1 = EXCO CPRIN1 COX1 ;
  17723. CHCOY1 = EXCO CPRIN1 COY1 ;
  17724. CHCOZ1 = EXCO CPRIN1 COZ1 ;
  17725. CHSI22 = EXCO CPRIN1 SI22 ;
  17726. CHCOX2 = EXCO CPRIN1 COX2 ;
  17727. CHCOY2 = EXCO CPRIN1 COY2 ;
  17728. CHCOZ2 = EXCO CPRIN1 COZ2 ;
  17729.  
  17730. *on transforme les composantes en champs par point
  17731. CKSI11 = CHAN CHPO MOD1 CHSI11 ;
  17732. CKCOX1 = CHAN CHPO MOD1 CHCOX1 ;
  17733. CKCOY1 = CHAN CHPO MOD1 CHCOY1 ;
  17734. CKCOZ1 = CHAN CHPO MOD1 CHCOZ1 ;
  17735. CKSI22 = CHAN CHPO MOD1 CHSI22 ;
  17736. CKCOX2 = CHAN CHPO MOD1 CHCOX2 ;
  17737. CKCOY2 = CHAN CHPO MOD1 CHCOY2 ;
  17738. CKCOZ2 = CHAN CHPO MOD1 CHCOZ2 ;
  17739.  
  17740. *on renomme correctement les composantes
  17741. CLSI11 = NOMC SCAL CKSI11 ;
  17742. CLCOX1 = NOMC UX CKCOX1 ;
  17743. CLCOY1 = NOMC UY CKCOY1 ;
  17744. CLCOZ1 = NOMC UZ CKCOZ1 ;
  17745.  
  17746. CLSI22 = NOMC SCAL CKSI22 ;
  17747. CLCOX2 = NOMC UX CKCOX2 ;
  17748. CLCOY2 = NOMC UY CKCOY2 ;
  17749. CLCOZ2 = NOMC UZ CKCOZ2 ;
  17750.  
  17751. *CLSI11_P = CLSI11 * ( CLSI11 MASQUE SUPERIEUR 0. );
  17752. *CLSI11_N = CLSI11 * ( CLSI11 MASQUE INFERIEUR 0. );
  17753. *CLSI22_P = CLSI22 * ( CLSI22 MASQUE SUPERIEUR 0. );
  17754. *CLSI22_N = CLSI22 * ( CLSI22 MASQUE INFERIEUR 0. );
  17755. CLSI11_P = CLSI11 MASQUE SUPERIEUR 0. ;
  17756. CLSI11_N = CLSI11 MASQUE INFERIEUR 0. ;
  17757. CLSI22_P = CLSI22 MASQUE SUPERIEUR 0. ;
  17758. CLSI22_N = CLSI22 MASQUE INFERIEUR 0. ;
  17759.  
  17760. *on multiplie les cosinus directeurs par la norme -1 ou +1
  17761.  
  17762. CMCOX1P = CLSI11_P * CLCOX1 ;
  17763. CMCOY1P = CLSI11_P * CLCOY1 ;
  17764. CMCOZ1P = CLSI11_P * CLCOZ1 ;
  17765.  
  17766. CMCOX1N = CLSI11_N * CLCOX1 ;
  17767. CMCOY1N = CLSI11_N * CLCOY1 ;
  17768. CMCOZ1N = CLSI11_N * CLCOZ1 ;
  17769.  
  17770. CMCOX2P = CLSI22_P * CLCOX2 ;
  17771. CMCOY2P = CLSI22_P * CLCOY2 ;
  17772. CMCOZ2P = CLSI22_P * CLCOZ2 ;
  17773.  
  17774. CMCOX2N = CLSI22_N * CLCOX2 ;
  17775. CMCOY2N = CLSI22_N * CLCOY2 ;
  17776. CMCOZ2N = CLSI22_N * CLCOZ2 ;
  17777.  
  17778.  
  17779. * on cree des champs par point contenat toutes les composantes
  17780. CH1P = CMCOX1P + CMCOY1P + CMCOZ1P ;
  17781. CH1N = CMCOX1N + CMCOY1N + CMCOZ1N ;
  17782. CH2P = CMCOX2P + CMCOY2P + CMCOZ2P ;
  17783. CH2N = CMCOX2N + CMCOY2N + CMCOZ2N ;
  17784.  
  17785.  
  17786. * on cree le champs de vecteurs
  17787. COEF1 = 2.E-11 ;
  17788. COEF1 = .00017 ;
  17789. VVEC1P = VECT CH1P COEF1 'UX' 'UY' ROUGE ;
  17790. VVEC1N = VECT CH1N COEF1 'UX' 'UY' VERT ;
  17791. VVEC2P = VECT CH2P COEF1 'UX' 'UY' ROUGE ;
  17792. VVEC2N = VECT CH2N COEF1 'UX' 'UY' VERT ;
  17793. WVEC1P = VECT (-1. * CH1P) COEF1 'UX' 'UY' ROUGE ;
  17794. WVEC1N = VECT (-1. * CH1N) COEF1 'UX' 'UY' VERT ;
  17795. WVEC2P = VECT (-1. * CH2P) COEF1 'UX' 'UY' ROUGE ;
  17796. WVEC2N = VECT (-1. * CH2N) COEF1 'UX' 'UY' VERT ;
  17797.  
  17798.  
  17799. SI (EXISTE MAIL1 ) ;
  17800. TRAC (VVEC1P ET VVEC1N ET WVEC1P ET WVEC1N ET VVEC2P ET VVEC2N ET WVEC2P ET WVEC2N) MAIL1 ;
  17801. SINON ;
  17802. TRAC (VVEC1P ET VVEC1N ET WVEC1P ET WVEC1N ET VVEC2P ET VVEC2N ET WVEC2P ET WVEC2N) STOT1 ;
  17803. FINSI ;
  17804.  
  17805.  
  17806.  
  17807. * maintenant , on peut diminuer la quantite d'information en
  17808. * ne donnant que les directions
  17809.  
  17810. *CH1 = CLCOX1 + CLCOY1 + CLCOZ1 ;
  17811. *CH2 = CLCOX2 + CLCOY2 + CLCOZ2 ;
  17812.  
  17813. *VVEC1 = VECT CH1 .00015 'UX' 'UY' TURQ ;
  17814. *VVEC2 = VECT CH2 .00015 'UX' 'UY' TURQ ;
  17815. *VVEC3 = VECT (-1. * CH1) .00015 'UX' 'UY' TURQ ;
  17816. *VVEC4 = VECT (-1. * CH2) .00015 'UX' 'UY' TURQ ;
  17817.  
  17818.  
  17819. *TRAC (VVEC1 ET VVEC2 ET VVEC3 ET VVEC4) CON3 ;
  17820. *TRAC (VVEC1 ET VVEC3) CON3 ;
  17821. *TRAC (VVEC2 ET VVEC4) CON3 ;
  17822.  
  17823.  
  17824.  
  17825. MESS '-----------------------------------> sortie de PRINRAPH ' ;
  17826. FINPROC ;
  17827.  
  17828.  
  17829. **** @PTRANS
  17830. 'DEBPROC' @PTRANS TAB1*'TABLE' ;
  17831. SI (NON (EXISTE TAB1 NISOV)) ;
  17832. TAB1.NISOV = 7 ;
  17833. FINSI ;
  17834. MESS '>PTRANS TAB1.NISOV' TAB1.NISOV ;
  17835. NIVEAU = TAB1.'NIVEAU' ;
  17836. SI (NIVEAU >EG 4 ) ;
  17837. MESS '---------------------------------> calling @PTRANS';
  17838. FINSI ;
  17839. ICORSA1 = 0 ;
  17840. IVALI1 = 1 ;
  17841. SI ( NON (EXISTE TAB1 VIEW_P )) ;
  17842. TAB1.VIEW_P = TEXT ' ' ;
  17843. TEX2 = TEXT ' ' ;
  17844. SI ( EGA ( VALE DIME) 3 ) ;
  17845. TAB1.VIEW_P = 1.E8 -1.E8 1.E8 ;
  17846. FINSI ;
  17847. FINSI ;
  17848. C_ONT1 = TAB1.M_IL_CONTOUR ;
  17849. S_TOT1 = TAB1.M_ILLAGE_TOT ;
  17850. *VIN = TAB1 . V_IN RM 23.01.96 ;
  17851. VIN = TAB1.V_LOCAL ;
  17852. TIN = TAB1 . T_IN ;
  17853. PIN = TAB1 . P_IN ;
  17854. TTAPE = TAB1 . T_TAPE ;
  17855. YTWIST = TAB1 . TWIST_RATIO ;
  17856. LAMBDA = TAB1 . 'LAMBDA' ;
  17857. AMPLV1 = ( TAB1 . D_MAQUETTE ) / ( 2. * TAB1.MAX_SOFL ) ;
  17858. VPAT1 = TAB1.V_VPAT1 ;
  17859. FLUMOY1 = TAB1.V_FLUMOY1 ;
  17860. COTETF1 = TAB1.C_COTETF1 ;
  17861. SITETF1 = TAB1.C_SITETF1 ;
  17862. COTETR1 = TAB1.C_COTETR1 ;
  17863. SITETR1 = TAB1.C_SITETR1 ;
  17864. COTETC1 = TAB1.C_COTETC1 ;
  17865. SITETC1 = TAB1.C_SITETC1 ;
  17866. TAC8 = TABLE TAB1.T_TAC8 ;
  17867. TAC2 = TABLE ;
  17868. TAC2.1 = 'MARQ CROI REGU TITRE INC_POWER' ;
  17869. TAC2.2 = 'MARQ PLUS REGU TITRE RAD_POWER' ;
  17870. TAC2.3 = 'MARQ LOSA REGU TITRE CONV_POWER' ;
  17871. *RM011098
  17872. si (existe tab1 points) ;
  17873. ind1 = inde (tab1.points) ;
  17874. finsi ;
  17875.  
  17876.  
  17877.  
  17878. * on est dans @ptrans *********************************************
  17879. SI ( TAB1.TRANSITOIRE ) ;
  17880. * TEMPS ;
  17881. * MESS '>>>>> 4.10 >>>>>>' ;
  17882. VFPAT1 = TAB1.V_VPAT1 * (EXTR TAB1.LIS_FLUX ( DIME TAB1.LIS_FLUX ));
  17883. PHIZERO = (EXTR TAB1.LIS_FLUX ( DIME TAB1.LIS_FLUX ));
  17884. SI ( EXISTE TAB1 'LAMDAQ' ) ;
  17885. SI ( EXISTE TAB1 'CENTRE_PLASMA' ) ;
  17886. PUI1 = TAB1.V_FLUMOY1 * (TAB1 . B_HEATED) * (TAB1.WE_HEATED ) ;
  17887. SINON ;
  17888. PUI1 = TAB1.V_FLUMOY1 * (TAB1 . L_HEATED) * (TAB1.WE_HEATED ) ;
  17889. FINSI ;
  17890. SINON ;
  17891. PUI1 = TAB1.V_FLUMOY1 * (TAB1 . L_HEATED) * (TAB1.W_HEATED ) ;
  17892. FINSI;
  17893. * TMOY = TAB1.'TETA' ;
  17894. IFIG = 0 ;
  17895. IFIG = IFIG + 1 ;
  17896. TITRE '-p' IFIG '-BILAN DES PUIS.' PHIZERO ;
  17897.  
  17898. DESSIN ( ( TAB1.'EFLUI' ) ET ( TAB1.'EFLUR' ) ET ( TAB1.'EFLUC' ) ) LEGE TAC2 ;
  17899. *tc ajout d'un finsi au pif!!!!!!!!!!
  17900. 'FINSI';
  17901. *
  17902. *
  17903. si (existe tab1 LI_POINT) ;
  17904. TAB1.LIS_TEMP = TABLE ;
  17905. IPP1 = 0 ;
  17906. REPETER BOUPO6 ((DIME TAB1.LI_POINT) + 1 );
  17907. TAB1.LIS_TEMP . IPP1 = PROG;
  17908. IPP1 = IPP1 + 1 ;
  17909. FIN BOUPO6;
  17910. finsi ;
  17911.  
  17912. si (existe tab1 points) ;
  17913. TAB1.LIS_TEMP = TABLE ;
  17914. TAB1.LIS_TEMP . 0. = PROG;
  17915. REPETER BOUPO6 ;
  17916. si (exis ind1 &BOUPO6) ;
  17917. TAB1.LIS_TEMP . &BOUPO6 = PROG;
  17918. sinon ;
  17919. quitter BOUPO6 ;
  17920. finsi ;
  17921. FIN BOUPO6;
  17922. finsi ;
  17923.  
  17924. I_0 = -1 ;
  17925. I_1 = I_0 ;
  17926. LSORT1 = TAB1 .LI_SORT1 ;
  17927. LSORT2 = TAB1 .LI_SORT2 ;
  17928. SI ( NON (EXISTE TAB1 OPT_SORT2) ) ;
  17929. TAB1.OPT_SORT2 = MOT ' ' ;
  17930. FINSI ;
  17931. EVTRT = EVOL MANU ( PROG ) ( PROG ) ;
  17932. PTT1 = PROG ;
  17933. II2 = 0 ;
  17934. EVTTR1 = EVOL MANU ( PROG 0. ) ( PROG 0. ) ;
  17935. TAC4 = TABLE ;
  17936. ROUGE = MOT ' ' ;
  17937. * TAC4.1 = 'MARQ CROI REGU TITRE ROUGE' ;
  17938. TAC4.2 = 'MARQ PLUS REGU ' ;
  17939. TAC4.3 = 'MARQ PLUS REGU ' ;
  17940. TAC4.4 = 'MARQ ETOI REGU ' ;
  17941. TAC4.5 = 'MARQ ETOI REGU ' ;
  17942. TAC4.6 = 'MARQ CARR REGU ' ;
  17943. TAC4.7 = 'MARQ CARR REGU ' ;
  17944. TAC4.8 = 'MARQ LOSA REGU ' ;
  17945. TAC4.9 = 'MARQ LOSA REGU ' ;
  17946. TAC4.10 = 'MARQ TRIA REGU ' ;
  17947. TAC4.11 = 'MARQ TRIA REGU ' ;
  17948. TAC4.12 = 'MARQ TRIB REGU ' ;
  17949. TAC4.13 = 'MARQ TRIB REGU ' ;
  17950. TAC4.14 = 'MARQ CROI REGU ' ;
  17951. TAC4.15 = 'MARQ CROI REGU ' ;
  17952. TAC4.16 = 'MARQ PLUS REGU ' ;
  17953. TAC4.17 = 'MARQ PLUS REGU ' ;
  17954. TAC4.18 = 'MARQ ETOI REGU ' ;
  17955. TAC4.19 = 'MARQ ETOI REGU ' ;
  17956. TAC4.20 = 'MARQ CARR REGU ' ;
  17957. TAC4.21 = 'MARQ CARR REGU ' ;
  17958. TAC4.22 = 'MARQ LOSA REGU ' ;
  17959. TAC4.23 = 'MARQ LOSA REGU ' ;
  17960. TAC4.24 = 'MARQ TRIA REGU ' ;
  17961. TAC4.25 = 'MARQ TRIA REGU ' ;
  17962. TAC4.26 = 'MARQ TRIB REGU ' ;
  17963. TAC4.27 = 'MARQ TRIB REGU ' ;
  17964. TAC4.28 = 'MARQ PLUS REGU ' ;
  17965. REPETER BEXP1 ;
  17966. I_1 = I_1 + 1 ;
  17967. * MESS ' exploitation pas ' I_1 ;
  17968. SI ( NON ( EXISTE TAB1 I_1 ) ) ;
  17969. QUITTER BEXP1 ;
  17970. FINSI ;
  17971. *
  17972. *--- EXTRACTION DES TEMP. AUX PTS DESIRES
  17973. *
  17974. * les 10 lignes suivantes sont assez délicates
  17975. * svp ne pas modifier sans l'avis de RM ou JS
  17976. TE1 = EXCO 'T' ( TAB1. I_1 . TEMPERATURE ) ;
  17977. TT1 = TAB1. I_1 . 'INSTANT' ;
  17978. PTT1 = PTT1 ET ( PROG TT1 ) ;
  17979. IPP1 = 0 ;
  17980.  
  17981. SI ( EXISTE TAB1 LI_POINT ) ;
  17982. REPETER BOUPO7 ( DIME TAB1.LI_POINT) ;
  17983. IPP1 = IPP1 + 1 ;
  17984. * rm 10/09/96 T_P1 = TEXT (EXTR IPP1 TAB1.LI_POINT);
  17985. T_P1 = text ('EXTR' IPP1 TAB1.LI_POINT) ;
  17986. * list (TYPE (T_P1)) ;
  17987. SI (EGA T_P1 '_MAX') ;
  17988. TMIP1 = MAXI TE1 ;
  17989. SINON ;
  17990. T_P3 = S_TOT1 'POIN' 'PROC' (T_P1) ;
  17991. TMIP1 = EXTR ( TAB1. I_1. TEMPERATURE ) 'T' T_P3;
  17992. FINSI ;
  17993. TAB1.LIS_TEMP . IPP1 = ( TAB1.LIS_TEMP . IPP1 ) ET ( PROG TMIP1 ) ;
  17994. FIN BOUPO7 ;
  17995. FINSI ;
  17996. * autre syntaxe pour le meme resultat, RM011098
  17997. si (existe tab1 points) ;
  17998. repe boupo7 ;
  17999. si (existe ind1 &boupo7) ;
  18000. nom1 = ind1.&boupo7 ;
  18001. poa1 = tab1.points.nom1 ;
  18002. si (ega nom1 '_max');
  18003. tmip1 = maxi te1 ;
  18004. sinon ;
  18005. tmip1 = extr ( tab1. i_1. temperature ) 'T' poa1;
  18006. finsi ;
  18007. TAB1.LIS_TEMP . &boupo7 = ( TAB1.LIS_TEMP . &boupo7 ) ET ( PROG TMIP1 ) ;
  18008. sinon ;
  18009. quitter boupo7 ;
  18010. finsi ;
  18011. fin boupo7;
  18012. finsi ;
  18013. ISORT1 = 0 ;
  18014. IS1 = 0 ;
  18015. REPETER BEXP2 ( DIME LSORT1 ) ;
  18016. IS1 = IS1 + 1 ;
  18017. TS1 = EXTR LSORT1 IS1 ;
  18018. SI ( TT1 EGA TS1 1.E-3 )  ;
  18019. ISORT1 = 1 ;
  18020. QUITTER BEXP2  ;
  18021. FINSI ;
  18022. FIN BEXP2 ;
  18023. ISORT2 = 0 ;
  18024. IS2 = 0 ;
  18025.  
  18026. REPETER BEXP3 ( DIME LSORT2 ) ;
  18027. IS2 = IS2 + 1 ;
  18028. TS2 = EXTR LSORT2 IS2 ;
  18029. SI ( TT1 EGA TS2 1.E-3 ) ;
  18030. ISORT2 = 1 ;
  18031. QUITTER BEXP3 ;
  18032. FINSI ;
  18033. FIN BEXP3 ;
  18034. *
  18035. SI ( ISORT1 EGA 1 ) ;
  18036. *
  18037. FCOEF = IPOL TT1 (TAB1.'PTF1') (TAB1.'PCF1') ;
  18038. CHPX = EXCO SCAL ( VFPAT1 * ( COTETF1 ) ) UX ;
  18039. CHPY = EXCO SCAL ( VFPAT1 * ( SITETF1 ) ) UY ;
  18040. CHPT2 = @ET CHPX CHPY ;
  18041. * changement de couleur possible des fleches du flux a la paroi
  18042. ROUGE = 'ROUGE';
  18043. VEC_22 = @VECADA CHPT2 ( FCOEF * -1. * AMPLV1 ) ROUGE ;
  18044.  
  18045. TAB1. V_VEC22 = VEC_22 ;
  18046. SI ( EGA I_1 0 ) ;
  18047. HCONVT1 = HCON1 ;
  18048. SINON ;
  18049. HCONVT1 = EXCO 'H' ( TAB1. I_1 . COEFHCONV ) ;
  18050. FINSI ;
  18051. TECA0 = ( REDU TE1 TAB1.LFLUX_CONV ) ;
  18052. FCNV2 = ( TECA0 - TAB1.'TETA' ) * HCONVT1 ;
  18053. CHPCX = EXCO SCAL ( FCNV2 * ( COTETC1 ) ) UX ;
  18054. CHPCY = EXCO SCAL ( FCNV2 * ( SITETC1 ) ) UY ;
  18055. CHPCT = ( CHPCX @ET CHPCY ) ;
  18056. VEC_1 = @VECADA CHPCT ( 1. * AMPLV1 ) ROUGE ;
  18057. TAB1. V_VEC1 = VEC_1 ;
  18058. *
  18059. * trace sur le meme graphe des conditions thermohydrauliques a la paroi
  18060. * FLUX/1.E6, Temperatures/10.
  18061. *
  18062. TITRE '-p' IFIG '- TIME AND PHI0 ' TT1 ( PHIZERO * FCOEF ) ;
  18063. FLUITT1 = TAB1.V_FLUMOY1 * FCOEF ;
  18064. LMARQ1 = MOTS 'LOSA' 'TRIA' 'TRIB' 'LOSA' 'TRIA' 'TRIB' ;
  18065. TAC2 = TABLE ;
  18066. TAC2.1 = 'MARQ CARR REGU TITRE WALL_FLUX' ;
  18067. EVFLC1 = EVOL VERT 'CHPO' (FCNV2/1.E6) SCAL TAB1.LFLUX_CONV_DESS;
  18068. PLINT1 = EXTR EVFLC1 ABSC 1 ;
  18069. EVETOT1 = EVFLC1 ;
  18070.  
  18071. NB_FLUX = DIME TAB1.'L_QCHFW' ;
  18072. I1 = 0 ;
  18073. REPETER BOUC_CHF NB_FLUX ;
  18074. I1 = I1 + 1 ;
  18075. EVQCRI1 = EVOL VERT MANU PLINT1 (PROG (DIME PLINT1) * ((EXTR TAB1.'L_QCHFW' I1)/1.E6)) ;
  18076. EVETOT1 = EVETOT1 ET EVQCRI1 ;
  18077. SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'TONG') ;
  18078. NOM_CORR = TAB1.M_TONG ;
  18079. FINSI ;
  18080. SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'BOWR') ;
  18081. NOM_CORR = 'BOWRING72' ;
  18082. FINSI ;
  18083. SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'CELA') ;
  18084. NOM_CORR = 'CELATA94' ;
  18085. FINSI ;
  18086. TAC2.(I1 + 1 ) = CHAIN 'MARQ ' (EXTR LMARQ1 I1) ' REGU TITRE ' NOM_CORR ;
  18087. FIN BOUC_CHF ;
  18088.  
  18089. EVTC1 = EVOL ROUG 'CHPO' (TECA0/10.) SCAL TAB1.LFLUX_CONV_DESS ;
  18090. TAC2.(2 + I1 ) = 'MARQ CROI REGU TITRE WALL_TEMP' ;
  18091. EVETOT1 = EVETOT1 ET EVTC1 ;
  18092.  
  18093. EVTONB = EVOL ROUG MANU PLINT1 (PROG (DIME PLINT1) * (TAB1.V_TONB /10. )) ;
  18094. TAC2.(3 + I1) = 'MARQ ETOI REGU TITRE TONB' ;
  18095. EVETOT1 = EVETOT1 ET EVTONB ;
  18096.  
  18097. MESS '>@PTRANS> THERMOHYDRAULICS AT T = ' TT1 ;
  18098. DESSIN EVETOT1 LEGE MIMA TAC2 ;
  18099.  
  18100. SI ( EXISTE TAB1 LFLUX_RAYO ) ;
  18101. HRAYOT1 = EXCO 'H' ( TAB1. I_1 . COEFHRAYO ) ;
  18102. TERA1 = ( REDU TE1 (TAB1 . LFLUX_RAYO) ) ;
  18103. FRAY2 = HRAYOT1 * ( TERA1 - (TAB1 . TEMP_RAYO)) ;
  18104. CHPRX = EXCO SCAL ( FRAY2 * ( COTETR1 ) ) UX ;
  18105. CHPRY = EXCO SCAL ( FRAY2 * ( SITETR1 ) ) UY ;
  18106. CHPRT = ( CHPRX @ET CHPRY ) ;
  18107. *>>>>>>>> modif bonnefoi du 6/04/93
  18108. * VER1 = VECT CHPRT ( AMPLV1 ) UX UY ROUG ;
  18109. VER1 = @VECADA CHPRT ( AMPLV1 ) ROUG ;
  18110. TAB1. V_VER1 = VER1 ;
  18111. EVTR1 = EVOL 'CHPO' ( TERA1 * 1.E5 ) SCAL (TAB1 . LFLUX_RAYO_DESS);
  18112. EVFLR1 = EVOL 'CHPO' FRAY2 SCAL (TAB1 . LFLUX_RAYO_DESS) ;
  18113. TITRE '-p'IFIG '- EXT. SURF. T. PROFILE ' TT1 ( PHIZERO * FCOEF );
  18114. TAC2.1 = 'MARQ CROI REGU TITRE RADIATIVE_FLUX' ;
  18115. *js 050997 TAC2.3 = 'MARQ CARR REGU TITRE L_RAYO_TEMP' ;
  18116. TAC2.2 = 'MARQ CARR REGU TITRE L_RAYO_TEMP' ;
  18117. MESS '>@PTRANS> 32.1 ' ;
  18118. DESSIN (EVFLR1 ET EVTR1 ) LEGE MIMA TAC2 ;
  18119. FINSI ;
  18120. TITRE '-p' IFIG '- ISOV. TEMP.' TT1 ( PHIZERO * FCOEF ) ;
  18121. * TRACER TAB1.VIEW_P CACH
  18122. * ( TAB1. I_1 . TEMPERATURE ) S_TOT1 C_ONT1;
  18123. MESS '>@PTRANS> TEMP ISOVALUES AT T = ' TT1 ;
  18124. *>>>>>modif J.F. Salavy le 04/05/95 : ajout de la possibilite de
  18125. *>>>>>tracer avec echelle constante au cours du temps. Cette echelle
  18126. *>>>>>TAB1.LECHTR est une prog de 14 valeurs definie dans le jeu de
  18127. *>>>>>donnees en fonction de Tmin et Tmax
  18128. SI ( EXISTE TAB1 LECHTR ) ;
  18129. MESS '>PTRANS 33.0>>>' ;
  18130. TRACER TAB1.LECHTR TAB1.VIEW_P CACH ( TAB1. I_1 . TEMPERATURE ) S_TOT1 C_ONT1 ( VEC_1 ET VER1 ET VEC_22 ) ;
  18131. SINON ;
  18132. MESS '>PTRANS 33.1>>>' ;
  18133. TRACER CACH TAB1.VIEW_P TAB1.NISOV ( TAB1. I_1 . TEMPERATURE ) S_TOT1 C_ONT1 ( VEC_1 ET VER1 ET VEC_22 ) ;
  18134. FINSI ;
  18135. SI ( EXISTE TAB1 VIEW_P2 ) ;
  18136. MESS '>PTRANS 33.2>>>' ;
  18137. TRAC CACH TAB1.VIEW_P2 TAB1.NISOV ( TAB1. I_1 . TEMPERATURE ) S_TOT1 C_ONT1 ( VEC_1 ET VER1 ET VEC_22 ) ;
  18138. FINSI ;
  18139. FINSI ;
  18140. SI ( ISORT2 EGA 1 ) ;
  18141. II2 = II2 + 1 ;
  18142. *js 050997 II21 = II2 * 2 - 1 + 1 ;
  18143. II21 = II2 ;
  18144. MESS '>@PTRANS> RAD,TEMP PROFILE AT T = ' TT1 II2 II21 ;
  18145. *
  18146. FCOEF = IPOL TT1 (TAB1.'PTF1') (TAB1.'PCF1') ;
  18147. *
  18148. SI ( EXISTE TAB1 LFLUX_RAYO ) ;
  18149. TITRE 'TIME' TT1 IFIG '- EXT. SURF. PROFILE ' ( PHIZERO * FCOEF );
  18150. TERA1 = ( REDU TE1 (TAB1 . LFLUX_RAYO) ) ;
  18151. EVTR1 = EVOL 'CHPO' ( TERA1 ) SCAL (TAB1 . LFLUX_RAYO_DESS);
  18152. EVTTR1 = EVTTR1 ET EVTR1 ;
  18153. SI ( EXISTE TAC4 II21 ) ;
  18154. TAC4.II21 = CHAINE TAC4.II21 ' TITRE ' TT1 ;
  18155. FINSI ;
  18156. * DESSIN EVTTR1 LEGE MIMA TAC4 ;
  18157. FINSI ;
  18158. FINSI ;
  18159. FIN BEXP1 ;
  18160. MESS ' end of the loop on the time to process ' ;
  18161. TTTTT1 = TEXT 'DESSIN EVTTR1 ' (TAB1.OPT_SORT2) 'LEGE MIMA TAC4 ' ;
  18162. TTTTT1 ;
  18163. * DESSIN EVTTR1 (TAB1.OPT_SORT2) LEGE MIMA TAC4 ;
  18164. *
  18165. TITRE '-P' IFIG '- EVOL. T. SURF.' PHIZERO ;
  18166. IPP8 = 0 ;
  18167. 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;
  18168. *js250796 TAC8 = TABLE ;
  18169. SI ( EXISTE TAB1 LI_POINT ) ;
  18170. REPETER BOUPO8 ( DIME TAB1.LI_POINT ) ;
  18171. IPP8 = IPP8 + 1 ;
  18172. MARQ1 = EXTR IPP8 LIST1;
  18173. N_P1 = EXTR IPP8 TAB1.LI_POINT ;
  18174. TAC8.IPP8 = CHAINE 'MARQ ' MARQ1 ' REGU TITR ' N_P1 ;
  18175. TITRE N_P1 ' TEMP CALCULATION ' ;
  18176. TAB1.EVT1 = EVOL MANU ' ' PTT1 'TEMPERATURE' TAB1. LIS_TEMP . IPP8 ;
  18177. SI ( IPP8 EGA 1 ) ;
  18178. TAB1.EVTTT1 = TAB1.EVT1 ;
  18179. SINON ;
  18180. TAB1.EVTTT1 = TAB1.EVTTT1 ET TAB1.EVT1 ;
  18181. FINSI ;
  18182. FIN BOUPO8 ;
  18183. MESS '>@PTRANS> >>> 5 >>>>>>>' ;
  18184. TITRE '-P' IFIG '- PROFIL T. SURF. EXT.' PHIZERO;
  18185. *
  18186. IFIG = IFIG + 1 ;
  18187. TITRE '-P' IFIG '- EVOL. T. SURF.' PHIZERO ;
  18188. SI ( NON (EXISTE TAB1 OPT_CADPT) ) ;
  18189. TAB1.OPT_CADPT = MOT ' ' ;
  18190. FINSI ;
  18191.  
  18192. * EVTR2 = EVT1 * 0. ;
  18193. * EVTTT1 = ( EVTTT1 ET EVTR2 ) ;
  18194. * DESSIN EVTTT1 LEGE MIMA TAC8 ;
  18195. TTTTT1 = TEXT 'DESSIN TAB1.EVTTT1 ' (TAB1.OPT_CADPT) 'LEGE MIMA TAC8 ' ;
  18196. TTTTT1 ;
  18197. MESS '>@PTRANS> >>> 6 >>>>>>>' ;
  18198. FINSI ;
  18199. si (existe tab1 points) ;
  18200. repe boupo8 ;
  18201. si (existe ind1 &boupo8) ;
  18202. marq1 = extr &boupo8 LIST1;
  18203. n_p1 = ind1.&boupo8 ;
  18204. TAC8.&boupo8 = CHAINE 'MARQ ' MARQ1 ' REGU TITR ' N_P1 ;
  18205. TITRE N_P1 ' TEMP CALCULATION ' ;
  18206. TAB1.EVT1 = EVOL MANU ' ' PTT1 'TEMPERATURE' TAB1. LIS_TEMP . &boupo8 ;
  18207. SI ( &boupo8 EGA 1 ) ;
  18208. TAB1.EVTTT1 = TAB1.EVT1 ;
  18209. SINON ;
  18210. TAB1.EVTTT1 = TAB1.EVTTT1 ET TAB1.EVT1 ;
  18211. FINSI ;
  18212. sinon ;
  18213. quitter boupo8 ;
  18214. finsi ;
  18215. fin boupo8 ;
  18216. MESS '>@PTRANS> >>> 5 >>>>>>>' ;
  18217. TITRE '-P' IFIG '- PROFIL T. SURF. EXT.' PHIZERO;
  18218. IFIG = IFIG + 1 ;
  18219. TITRE '-P' IFIG '- EVOL. T. SURF.' PHIZERO ;
  18220. SI ( NON (EXISTE TAB1 OPT_CADPT) ) ;
  18221. TAB1.OPT_CADPT = MOT ' ' ;
  18222. FINSI ;
  18223. TTTTT1 = TEXT 'DESSIN TAB1.EVTTT1 ' (TAB1.OPT_CADPT) 'LEGE MIMA TAC8 ' ;
  18224. TTTTT1 ;
  18225. MESS '>@PTRANS> >>> 6 >>>>>>>' ;
  18226. finsi ;
  18227. MESS '>>>>> 7 >>>>>>>' ;
  18228. SI (NIVEAU >EG 4) ;
  18229. MESS '---------------------------------> exiting @PTRANS';
  18230. FINSI ;
  18231. FINPROC ;
  18232.  
  18233.  
  18234. DEBPROC RAMRES CONT1*MCHAML MOD1*MMODEL MAIL1*MAILLAGE COMP1*MOT;
  18235.  
  18236. * calcul de la resultant d'un MCHAML
  18237.  
  18238.  
  18239. CONTU1 = REDU (EXTR MOD1 MAIL) CONT1;
  18240. CONTU2 = PROI MAIL1 (CHAN NOEUD MOD1 CONTU1) ;
  18241.  
  18242. * CONTU2 = CHAN CHPO MOD1 (CHAN NOEUD MOD1 CONTU1) ;
  18243. * CONTU3 = REDU CONTU2 MAIL1 ;
  18244. * CONTU4 = CHAN CHAM CONTU2 MAIL1 NOEUD ;
  18245.  
  18246. CONTU3 = CHAN CHAM CONTU2 MAIL1 NOEUD ;
  18247. MODD1 = MODE MAIL1 MECANIQUE ELASTIQUE ISOTROPE ;
  18248. VAL1 = INTG MODD1 CONTU3 COMP1 ;
  18249.  
  18250. * mettre une autre methode passat par REAC et
  18251. * que je trouve plus propre
  18252.  
  18253.  
  18254.  
  18255. FINPROC VAL1;
  18256.  
  18257. **** @RAPACQU
  18258. DEBPROC @RAPACQU NDON1*ENTIER NABSC1*ENTIER TAB1*TABLE;
  18259. MESS '--------------------------------> calling @RAPACQU';
  18260. I1 = 0 ;
  18261. REPETER BOUC1 NDON1 ;
  18262. I1 = I1 + 1 ;
  18263. TAB1.I1 = PROG ;
  18264. FIN BOUC1 ;
  18265.  
  18266. REPETER BOUC2 NABSC1;
  18267. ACQU LR1*LISTREEL NDON1;
  18268. I2 = 0 ;
  18269. REPETER BOUC3 NDON1;
  18270. I2 = I2 + 1 ;
  18271. TAB1.I2 = TAB1.I2 ET (PROG (EXTR LR1 I2));
  18272. FIN BOUC3;
  18273. FIN BOUC2 ;
  18274.  
  18275. MESS '--------------------------------> exiting @RAPACQU';
  18276. FINPROC ;
  18277.  
  18278.  
  18279.  
  18280.  
  18281. 'DEBPROC' RDPGTHPL RIG10*RIGIDITE MAT1*CHAMELEM ASCU0/AFFECTE TE1*CHPOINT TABDEP1*TABLE ;
  18282. *----------------------------------------------------------------------*
  18283. * *
  18284. * R D P G T H P L *
  18285. * --------------- *
  18286. * *
  18287. * RESOLUTION EN DEFORMATION PLANE GENERALISEE D UN *
  18288. * PB THERMOMECANIQUE *
  18289. * *
  18290. * *
  18291. * RIG10 MATRICE DE RIGIDITE *
  18292. * MAT1 CHAMELEM DES MATERIAUX *
  18293. * ( ASCU0 ) OBJET AFFECTE ( ELEMENTS FINIS ) *
  18294. * TE1 CHPOIN DE TEMPERATURE ( CHARGEMENT ) *
  18295. * TABDEP TABLE *
  18296. * INDICE 'NZ' EFFORT LONGITUDINAL IMPOSE *
  18297. * INDICE 'TINI' TEMPERATURE INITIALE *
  18298. * INDICE 'LIG1' LIGNE POUR APPLICATION CHARGEMENT BIDON *
  18299. * INDICE 'MX' MOMENT EN X IMPOSE *
  18300. * INDICE 'MY' ...A PROGRAMMER SUIV. MOD. MX *
  18301. * ( INDICE 'PO') CENTRE D'INERTIE DE VOTRE SURFACE *
  18302. * ( INDICE 'VX') LE VX POUR SFXX = MXX/(IXX/VX) *
  18303. * *
  18304. * EN SORTIE *
  18305. * DE1 CHPOINT DE DEPLACEMENT *
  18306. * SIG1 CONTRAINTES *
  18307. * *
  18308. * CE JEU DE DONNEES A ETE UTILISE TEL QUE ET A SEMBLE DONNER
  18309. * SATISFACTION *
  18310. * IL FAUDRAIT EN FAIRE UNE PROCEDURE *
  18311. * ET LE TESTER CONVENABLEMENT *
  18312. * *
  18313. * SCHLOSSER LE 13 9 90 *
  18314. * *
  18315. * SCHLOSSER LE 17 7 91 *
  18316. * *
  18317. * TABDEP1.'EPSI' CHAMELEM DES DEFORMATIONS
  18318. * TABDEP1.'RY' RAYON DE COURBURE EN Y
  18319. * TABDEP1.'EPZM' DEFORMATION MOYENNE EN Z *
  18320. * ( INDICE 'PO') CENTRE DE L AXE NEUTRE *
  18321. * ( INDICE 'VX') LE VX POUR SFXX = MXX/(IXX/VX) *
  18322. *----------------------------------------------------------------------*
  18323. *23456789012345678901234567890123456789012345678901234567890123456789012
  18324. *--------1---------2---------3---------4---------5---------6---------7-*
  18325. ******* CALCUL DES FORCES DUES AUX TEMPERATURES **************
  18326. *
  18327. MESS ' >>>>> ATTENTION VERIFIEZ QUE VOUS AVEZ PLAN DEFO >>>>>>>>' ;
  18328. LISTE ( VALEUR 'MODE' ) ;
  18329. SI ( EXISTE ASCU0 ) ;
  18330. ASCU1 = ASCU0 ;
  18331. SINON ;
  18332. ASCU1 = EXTR MAT1 'AFFE' ;
  18333. TITRE 'ASCU1';
  18334. TRACE ASCU1 ;
  18335. FINSI ;
  18336. MAIL_1 = EXTR ASCU1 'MAIL' ;
  18337. TITRE 'MAIL_1';
  18338. TRACE MAIL_1 ;
  18339. IGENE = 0 ;
  18340. SI_10 = THETA MAT1 ( TE1 - ( TABDEP1.TINI ) ) ;
  18341. SIONE = MANU CHAM ASCU1 CONTRAIN SMZZ 1. ;
  18342. SIERR = MANU CHAM ASCU1 CONTRAIN SMZZ 0. ;
  18343. SECC = EXTR SI_10 'MAIL' ;
  18344. A_1 = 1.0 ;
  18345. TOL_1 = 1.E-15 ;
  18346. TOL_2 = 1.E-18 ;
  18347. YG1 = CHAN 'STRESSES' ( EXCO 'YOUNG' MAT1 ) ;
  18348. SEC_1 = INTG SIONE SMZZ ;
  18349. MESS ' VOTRE SURFACE SECTION A VERIFIER' SEC_1 ;
  18350. SI ( EXISTE TABDEP1 NZ ) ;
  18351. IGENE = IGENE + 1 ;
  18352. FINSI ;
  18353. SI ( EXISTE TABDEP1 MX ) ;
  18354. IGENE = IGENE + 1 ;
  18355. PO_1 = BARY SECC ;
  18356. * L_Y1 = (( COOR 2 SECC ) - ( COOR 2 PO_1 ) ) ;
  18357. Y_1 = COOR 2 SECC ;
  18358. Y_2 = PRCH Y_1 ASCU1 STRESSES ;
  18359. Y_PO2 = ( INTG ( Y_2 * YG1 ) ) / ( INTG YG1 ) ;
  18360. L_Y1 = ( Y_1 - Y_PO2 ) ;
  18361. X_1 = COOR 1 SECC ;
  18362. X_2 = PRCH X_1 ASCU1 STRESSES ;
  18363. X_PO2 = ( INTG ( X_2 * YG1 ) ) / ( INTG YG1 ) ;
  18364. L_X1 = ( X_1 - X_PO2 ) ;
  18365. PO_2 = ( X_PO2 Y_PO2 ) ;
  18366. TABDEP1.PO = PO_2 ;
  18367. VX_1 = MAXI ( ABS L_Y1 ) ;
  18368. TABDEP1.VX = VX_1 ;
  18369. L_Y = PRCH L_Y1 ASCU1 STRESSES ;
  18370. IXX_1 = INTG ( L_Y * L_Y ) ;
  18371. MESS ' VOTRE BARICENTRE ' ( COOR 1 PO_1 ) ( COOR 2 PO_1 ) ;
  18372. MESS ' VOTRE CENTRE D AXE NEUTRE ' ( COOR 1 PO_2 ) ( COOR 2 PO_2 ) ;
  18373. MESS ' VOTRE VX ' VX_1 ;
  18374. MESS ' VOTRE INERTIE IXX A VERIFIER' IXX_1 ;
  18375. FINSI ;
  18376. IB = 0 ;
  18377. TBB1 = TABLE ;
  18378. TBB1.CHPOTHETA = TABLE ;
  18379. TBB1.PLASTIQUE = VRAI ;
  18380. TBB1.THERMIQUE = VRAI ;
  18381. TBB1.ITERATION = KSI ;
  18382. *TREFERENCE = 0.;
  18383. TBB1.CHPOTHETA . 0. = 0. ;
  18384. TBB1.CHPOTHETA . 1. = (TE1 - (MANU 'CHPO' MAIL_1 1 'T' ( TABDEP1.TINI ))) ;
  18385. VPREC = 0.1 ;
  18386. TBB1.MAXITERATION = 200 ;
  18387. TBB1.ACCELERATION = 20 ;
  18388. LIS1 = PROG 1. 1. ;
  18389. XF1 = PROG 0. 1. ;
  18390. F1 = FORCE FY 0. (TABDEP1.LIG1 ) ;
  18391. CHA1 = CHAR F1 ( EVOL MANU LIS1 XF1 ) ;
  18392. REPETER BODEPG 10 ;
  18393. TBB1 = TABLE ;
  18394. TBB1.CHPOTHETA = TABLE ;
  18395. TBB1.PLASTIQUE = VRAI ;
  18396. TBB1.THERMIQUE = VRAI ;
  18397. TBB1.ITERATION = KSI ;
  18398. *TREFERENCE = 0.;
  18399. TBB1.CHPOTHETA . 0. = 0. ;
  18400. TBB1.CHPOTHETA . 1. = (TE1 - (MANU 'CHPO' MAIL_1 1 'T' ( TABDEP1.TINI ))) ;
  18401. VPREC = 0.1 ;
  18402. TBB1.MAXITERATION = 200 ;
  18403. TBB1.ACCELERATION = 20 ;
  18404. IB = IB + 1 ;
  18405. MESS 'IB = ' IB ;
  18406. SI_11 = SI_10 - SIERR ;
  18407. FO1 = BSIGMA SI_11 ;
  18408. SI ( EXISTE TABDEP1 CHAMP ) ;
  18409. FO1 = FO1 ET ( TABDEP1 . CHAMP ) ;
  18410. FINSI ;
  18411. *MESS ' >>>>>>>fin 1er bsigma ' ;
  18412. *
  18413. ******* CALCUL DE LA SOLUTION **************
  18414. *
  18415. DE1 = RESOU RIG10 FO1 ;
  18416. MESS ' >>>>>>>fin resou ' ;
  18417. * SI_12 = SIGMA DE1 MAT1 ;
  18418. * SI_13 = SI_12 - SI_11 ;
  18419. TBB1.SIGI= SIERR*(+1.) ;
  18420. TBB1.PRECISION = VPREC / IB ;
  18421. NONLIN RIG10 MAT1 CHA1 LIS1 ASCU1 TBB1 ;
  18422. SI_13 = TBB1.RESUCONT . 1. ;
  18423. SI ( IB EGA 1 ) ;
  18424. * MSM1 = MAXI ( ABS SI_13 ) ;
  18425. MSM1 = MAXI ( ABS SI_10 ) ;
  18426. SI ( MSM1 &lt;EG 1.E-20 ) ; MSM1 = 1.E-20 ; FINSI ;
  18427. FINSI ;
  18428. DDD_1 = 0. ;
  18429. DDD_2 = 0. ;
  18430. SI ( EXISTE TABDEP1 NZ ) ;
  18431. FZ_1 = INTG SI_13 SMZZ ;
  18432. DFZ_1 = ( TABDEP1.NZ ) - FZ_1 ;
  18433. DSZ_1 = DFZ_1 / SEC_1 ;
  18434. DRZ_1 = ( ABS DSZ_1 ) / MSM1 ;
  18435. MESS ' ERREUR ABSOLU SIGZZ------' DSZ_1 ;
  18436. MESS ' ERREUR RELATIVE SIGZZ----' DRZ_1 ;
  18437. DDD_1 = DDD_1 + DRZ_1 ;
  18438. DDD_2 = DDD_2 + ( ABS DSZ_1 ) ;
  18439. SIERR = SIERR + ( MANU CHAM ASCU1 CONTRAIN SMZZ ( A_1 * DSZ_1 )) ;
  18440. MESS ' >>>>>>>fin sierr1 ' ;
  18441. FINSI ;
  18442. SI ( EXISTE TABDEP1 MX ) ;
  18443. MX_1 = INTG ( SI_13 * L_Y ) SMZZ ;
  18444. DMX_1 = ( TABDEP1.MX ) - MX_1 ;
  18445. DSX_1 = DMX_1 / IXX_1 * VX_1 ;
  18446. DRX_1 = ( ABS DSX_1 ) / MSM1 ;
  18447. MESS ' ERREUR ABSOLU EN FLEXION SIGFX------' DSX_1 ;
  18448. MESS ' ERREUR RELATIVE EN FLEXION SIGFX----' DRX_1 ;
  18449. DDD_1 = DDD_1 + DRX_1 ;
  18450. DDD_2 = DDD_2 + ( ABS DSX_1 ) ;
  18451. SIERR = SIERR + ( ( SIONE * L_Y ) * ( A_1 * DMX_1 / IXX_1 )) ;
  18452. MESS ' >>>>>>>fin sierr2 ' ;
  18453. FINSI ;
  18454. SI ( IGENE EGA 0 ) ;
  18455. QUITTER BODEPG ;
  18456. MESS ' >>>>>>>AUCUNE CONDITION DE DEFO GENE ' ;
  18457. MESS ' >>>>>>>CALCUL EFFECTUE EN PLAN ' ;
  18458. FINSI ;
  18459. SI ( IB >EG 2 ) ;
  18460. SI ( DDD_1 &lt;EG TOL_1 ) ; QUITTER BODEPG ; FINSI ;
  18461. SI ( DDD_2 &lt;EG TOL_2 ) ; QUITTER BODEPG ; FINSI ;
  18462. FINSI ;
  18463. MESS ' >>>>>>>on reboucle ' ;
  18464. FIN BODEPG ;
  18465. SIG1 = SI_13 ;
  18466. *ALPH1 = CHAN 'STRESSES' ( EXCO 'ALPH' MAT1 ) ;
  18467. *EPT = ALPH1 * ( PRCH TE1 ASCU1 'STRESSES' ) ;
  18468. ALPH1 = CHAN 'CHPO' ( EXCO 'ALPH' MAT1 ) ;
  18469. EPT = PRCH ( TE1 * ALPH1 ) ASCU1 'STRESSES' ;
  18470. *list EPT ;
  18471. ETXX = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPXX' EPT ;
  18472. ETYY = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPYY' EPT ;
  18473. ETZZ = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPZZ' EPT ;
  18474. CHEPS = ( ELAS SI_13 MAT1 ) + ETXX + ETYY + ETZZ ;
  18475. EPSZZ = EXCO EPZZ CHEPS ;
  18476. EPZM = ( INTG EPSZZ ) / SEC_1 ;
  18477. MESS ' VOTRE EPZ MOYEN : ' EPZM ;
  18478. EPBZ = EPSZZ - (( EPSZZ ** 0 ) * EPZM ) ;
  18479. SI ( EXISTE TABDEP1 MX ) ;
  18480. CHRY = L_Y * ( EPBZ ** -1 ) * -1. ;
  18481. MESS ' MAXI MINI DE VOTRE RY QUI DEVRAIT ETRE CONSTANT ' ( MAXI CHRY ) ( MINI CHRY ) ;
  18482. RY = ( INTG CHRY ) / SEC_1 ;
  18483. TABDEP1.'RY' = RY ;
  18484. FINSI ;
  18485. TABDEP1.'EPSI' = CHEPS ;
  18486. TABDEP1.'EPZM' = EPZM ;
  18487. FINPROC DE1 SIG1 ;
  18488. **** @REMOJET
  18489.  
  18490. DEBPROC @REMOJET XG_OLD2*CHPOINT YG_OLD2*CHPOINT ZG_OLD2*CHPOINT PAS0*FLOTTANT CHSIGN2*CHPOINT TAB1*TABLE ;
  18491.  
  18492. *MESS '---------------------------------> calling @remojet';
  18493. *
  18494. IMETHOD = TAB1.<METHODE_REMONTEE ;
  18495. *
  18496. *---- Methode Explicite
  18497. SI (IMETHOD EGA 1) ;
  18498. DEPX0 DEPY0 DEPZ0 = @DEXPJET XG_OLD2 YG_OLD2 ZG_OLD2 PAS0 TAB1;
  18499. SINON ;
  18500. ERRE '>>> METHODE INDISPONIBLE' ;
  18501. FINSI ;
  18502. *
  18503. *---- On affecte le signe donnant le sens de remontee
  18504. *---- aux deplacements
  18505. DEPX0 = CHSIGN2 * DEPX0 ;
  18506. DEPY0 = CHSIGN2 * DEPY0 ;
  18507. DEPZ0 = CHSIGN2 * DEPZ0 ;
  18508. *
  18509. *---- Calcul analytique des nouvelles coordonnees dans le
  18510. *---- repere global
  18511. XG_NEW2 = XG_OLD2 + DEPX0 ;
  18512. YG_NEW2 = YG_OLD2 + DEPY0 ;
  18513. ZG_NEW2 = ZG_OLD2 + DEPZ0 ;
  18514. *
  18515. *---- actualisation de la position des points de la ligne
  18516. DEPX0 = NOMC UX DEPX0 NATURE DIFFUS ;
  18517. DEPY0 = NOMC UY DEPY0 NATURE DIFFUS ;
  18518. DEPZ0 = NOMC UZ DEPZ0 NATURE DIFFUS ;
  18519. DEP0 = DEPX0 ET DEPY0 ET DEPZ0 ;
  18520. *
  18521. *MESS '---------------------------------> exiting @remojet';
  18522. FINPROC XG_NEW2 YG_NEW2 ZG_NEW2 DEP0 ;
  18523.  
  18524. **** @REMONTE
  18525.  
  18526. DEBPROC @REMONTE XG_OLD2*CHPOINT YG_OLD2*CHPOINT ZG_OLD2*CHPOINT PAS0*FLOTTANT CHSIGN2*CHPOINT TAB1*TABLE ;
  18527.  
  18528. *MESS '---------------------------------> calling @remonte';
  18529. *
  18530.  
  18531. IMETHOD = TAB1.<METHODE_REMONTEE ;
  18532.  
  18533. *---- Appel de la procedure de calcul des deplacements selon methode choisie
  18534. *---- Methode Explicite
  18535. SI (IMETHOD EGA 1) ;
  18536. DEPX0 DEPY0 DEPZ0 = @DEXPLI XG_OLD2 YG_OLD2 ZG_OLD2 PAS0 TAB1;
  18537. FINSI ;
  18538. *---- Methode Euler-Cauchy
  18539. SI (IMETHOD EGA 2) ;
  18540. DEPX0 DEPY0 DEPZ0 = @DMOYEN XG_OLD2 YG_OLD2 ZG_OLD2 PAS0 CHSIGN2 TAB1;
  18541. FINSI ;
  18542. *---- Methode Point Milieu Modifiee
  18543. SI (IMETHOD EGA 3) ;
  18544. DEPX0 DEPY0 DEPZ0 =@DMILIEU XG_OLD2 YG_OLD2 ZG_OLD2 PAS0 CHSIGN2 TAB1;
  18545. FINSI ;
  18546. *---- Methode de Reprojection
  18547. SI (IMETHOD EGA 4) ;
  18548. DEPX0 DEPY0 DEPZ0 =@DREPROJ XG_OLD2 YG_OLD2 ZG_OLD2 PAS0 CHSIGN2 TAB1;
  18549. FINSI ;
  18550.  
  18551. *---- On affecte le signe donnant le sens de remontee aux deplacements
  18552. DEPX0 = CHSIGN2 * DEPX0 ;
  18553. DEPY0 = CHSIGN2 * DEPY0 ;
  18554. DEPZ0 = CHSIGN2 * DEPZ0 ;
  18555.  
  18556. *---- Calcul analytique des nouvelles coordonnees dans le repere global
  18557.  
  18558. XG_NEW2 = XG_OLD2 + DEPX0 ;
  18559. YG_NEW2 = YG_OLD2 + DEPY0 ;
  18560. ZG_NEW2 = ZG_OLD2 + DEPZ0 ;
  18561.  
  18562. *MESS '---------------------------------> exiting @remonte';
  18563. FINPROC XG_NEW2 YG_NEW2 ZG_NEW2 ;
  18564.  
  18565. **** @repere
  18566. debproc @repere flot1*entier ;
  18567. o1 = 0. 0. 0. ;
  18568. 32taa1 = table ;
  18569. 32tab1 = table ;
  18570. 32tac1 = table ;
  18571.  
  18572. repe bouc1 10 ;
  18573. 32taa1.&bouc1 = &bouc1 0. 0. ;
  18574. 32tab1.&bouc1 = 0. &bouc1 0. ;
  18575. 32tac1.&bouc1 = 0. 0. &bouc1 ;
  18576. si (ega &bouc1 1 ) ;
  18577. geo1 = ((o1 d 1 32taa1.&bouc1) coul jaun) et ((o1 d 1 32tab1.&bouc1) coul bleu) et ((o1 d 1 32tac1.&bouc1) coul vert) ;
  18578. sinon ;
  18579. 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);
  18580.  
  18581. finsi ;
  18582. fin bouc1;
  18583. geo2 = geo1 homo flot1 o1 ;
  18584.  
  18585.  
  18586. finproc geo1 ;
  18587.  
  18588.  
  18589. **** RESDPG
  18590. *-------------------------------------------------
  18591.  
  18592. 'DEBPROC' RESDPG RIG10*RIGIDITE MAT1*CHAMELEM ASCU0/AFFECTE TE1*CHPOINT TABDEP1*TABLE ;
  18593. *----------------------------------------------------------------------*
  18594. * *
  18595. * R E S D P G *
  18596. * --------------- *
  18597. * *
  18598. * RESOLUTION EN DEFORMATION PLANE GENERALISEE D UN *
  18599. * PB THERMOMECANIQUE *
  18600. * *
  18601. * *
  18602. * RIG10 MATRICE DE RIGIDITE *
  18603. * MAT1 CHAMELEM DES MATERIAUX *
  18604. * ( ASCU0 ) OBJET AFFECTE ( ELEMENTS FINIS ) *
  18605. * TE1 CHPOIN DE TEMPERATURE ( CHARGEMENT ) *
  18606. * TABDEP TABLE *
  18607. * INDICE 'NZ' EFFORT LONGITUDINAL IMPOSE *
  18608. * INDICE 'MX' MOMENT EN X IMPOSE *
  18609. * INDICE 'MY' ...A PROGRAMMER SUIV. MOD. MX *
  18610. * ( INDICE 'PO') CENTRE D'INERTIE DE VOTRE SURFACE *
  18611. * ( INDICE 'VX') LE VX POUR SFXX = MXX/(IXX/VX) *
  18612. * *
  18613. * EN SORTIE *
  18614. * DE1 CHPOINT DE DEPLACEMENT *
  18615. * SIG1 CONTRAINTES *
  18616. * *
  18617. * CE JEU DE DONNEES A ETE UTILISE TEL QUE ET A SEMBLE DONNER
  18618. * SATISFACTION *
  18619. * IL FAUDRAIT EN FAIRE UNE PROCEDURE *
  18620. * ET LE TESTER CONVENABLEMENT *
  18621. * *
  18622. * SCHLOSSER LE 13 9 90 *
  18623. * *
  18624. * SCHLOSSER LE 17 7 91 *
  18625. * *
  18626. * TABDEP1.'EPSI' CHAMELEM DES DEFORMATIONS
  18627. * TABDEP1.'RY' RAYON DE COURBURE EN Y
  18628. * TABDEP1.'EPZM' DEFORMATION MOYENNE EN Z *
  18629. * ( INDICE 'PO') CENTRE DE L AXE NEUTRE *
  18630. * ( INDICE 'VX') LE VX POUR SFXX = MXX/(IXX/VX) *
  18631. *----------------------------------------------------------------------*
  18632. *
  18633. ******* CALCUL DES FORCES DUES AUX TEMPERATURES **************
  18634. *
  18635. MESS ' >>>>> ATTENTION VERIFIEZ QUE VOUS AVEZ PLAN DEFO >>>>>>>>' ;
  18636. LISTE ( VALEUR 'MODE' ) ;
  18637. SI ( EXISTE ASCU0 ) ;
  18638. ASCU1 = ASCU0 ;
  18639. SINON ;
  18640. ASCU1 = EXTR MAT1 'AFFE' ;
  18641. FINSI ;
  18642. IGENE = 0 ;
  18643. SI_10 = THETA MAT1 TE1 ;
  18644. SIONE = MANU CHAM ASCU1 CONTRAIN SMZZ 1. ;
  18645. SIERR = MANU CHAM ASCU1 CONTRAIN SMZZ 0. ;
  18646. SECC = EXTR SI_10 'MAIL' ;
  18647. A_1 = 1.0 ;
  18648. TOL_1 = 1.E-15 ;
  18649. TOL_2 = 1.E-18 ;
  18650. YG1 = CHAN 'STRESSES' ( EXCO 'YOUNG' MAT1 ) ;
  18651. SEC_1 = INTG SIONE SMZZ ;
  18652. MESS ' VOTRE SURFACE SECTION A VERIFIER' SEC_1 ;
  18653. SI ( EXISTE TABDEP1 NZ ) ;
  18654. IGENE = IGENE + 1 ;
  18655. FINSI ;
  18656. SI ( EXISTE TABDEP1 MX ) ;
  18657. IGENE = IGENE + 1 ;
  18658. PO_1 = BARY SECC ;
  18659. * L_Y1 = (( COOR 2 SECC ) - ( COOR 2 PO_1 ) ) ;
  18660. Y_1 = COOR 2 SECC ;
  18661. Y_2 = PRCH Y_1 ASCU1 STRESSES ;
  18662. Y_PO2 = ( INTG ( Y_2 * YG1 ) ) / ( INTG YG1 ) ;
  18663. L_Y1 = ( Y_1 - Y_PO2 ) ;
  18664. X_1 = COOR 1 SECC ;
  18665. X_2 = PRCH X_1 ASCU1 STRESSES ;
  18666. X_PO2 = ( INTG ( X_2 * YG1 ) ) / ( INTG YG1 ) ;
  18667. L_X1 = ( X_1 - X_PO2 ) ;
  18668. PO_2 = ( X_PO2 Y_PO2 ) ;
  18669. TABDEP1.PO = PO_2 ;
  18670. VX_1 = MAXI ( ABS L_Y1 ) ;
  18671. TABDEP1.VX = VX_1 ;
  18672. L_Y = PRCH L_Y1 ASCU1 STRESSES ;
  18673. IXX_1 = INTG ( L_Y * L_Y ) ;
  18674. MESS ' VOTRE BARICENTRE ' ( COOR 1 PO_1 ) ( COOR 2 PO_1 ) ;
  18675. MESS ' VOTRE CENTRE D AXE NEUTRE ' ( COOR 1 PO_2 ) ( COOR 2 PO_2 ) ;
  18676. MESS ' VOTRE VX ' VX_1 ;
  18677. MESS ' VOTRE INERTIE IXX A VERIFIER' IXX_1 ;
  18678. FINSI ;
  18679. IB = 0 ;
  18680. REPETER BODEPG 10 ;
  18681. IB = IB + 1 ;
  18682. MESS 'IB = ' IB ;
  18683. SI_11 = SI_10 - SIERR ;
  18684. FO1 = BSIGMA SI_11 ;
  18685. SI ( EXISTE TABDEP1 CHAMP ) ;
  18686. FO1 = FO1 ET ( TABDEP1 . CHAMP ) ;
  18687. FINSI ;
  18688. *MESS ' >>>>>>>fin 1er bsigma ' ;
  18689. *
  18690. ******* CALCUL DE LA SOLUTION **************
  18691. *
  18692. DE1 = RESOU RIG10 FO1 ;
  18693. MESS ' >>>>>>>fin resou ' ;
  18694. SI_12 = SIGMA DE1 MAT1 ;
  18695. SI_13 = SI_12 - SI_11 ;
  18696. SI ( IB EGA 1 ) ;
  18697. * MSM1 = MAXI ( ABS SI_13 ) ;
  18698. MSM1 = MAXI ( ABS SI_10 ) ;
  18699. SI ( MSM1 &lt;EG 1.E-20 ) ; MSM1 = 1.E-20 ; FINSI ;
  18700. FINSI ;
  18701. DDD_1 = 0. ;
  18702. DDD_2 = 0. ;
  18703. SI ( EXISTE TABDEP1 NZ ) ;
  18704. FZ_1 = INTG SI_13 SMZZ ;
  18705. DFZ_1 = ( TABDEP1.NZ ) - FZ_1 ;
  18706. DSZ_1 = DFZ_1 / SEC_1 ;
  18707. DRZ_1 = ( ABS DSZ_1 ) / MSM1 ;
  18708. MESS ' ERREUR ABSOLU SIGZZ------' DSZ_1 ;
  18709. MESS ' ERREUR RELATIVE SIGZZ----' DRZ_1 ;
  18710. DDD_1 = DDD_1 + DRZ_1 ;
  18711. DDD_2 = DDD_2 + ( ABS DSZ_1 ) ;
  18712. SIERR = SIERR + ( MANU CHAM ASCU1 CONTRAIN SMZZ ( A_1 * DFZ_1 / SEC_1 )) ;
  18713. MESS ' >>>>>>>fin sierr1 ' ;
  18714. FINSI ;
  18715. SI ( EXISTE TABDEP1 MX ) ;
  18716. MX_1 = INTG ( SI_13 * L_Y ) SMZZ ;
  18717. DMX_1 = ( TABDEP1.MX ) - MX_1 ;
  18718. DSX_1 = DMX_1 / IXX_1 * VX_1 ;
  18719. DRX_1 = ( ABS DSX_1 ) / MSM1 ;
  18720. MESS ' ERREUR ABSOLU EN FLEXION SIGFX------' DSX_1 ;
  18721. MESS ' ERREUR RELATIVE EN FLEXION SIGFX----' DRX_1 ;
  18722. DDD_1 = DDD_1 + DRX_1 ;
  18723. DDD_2 = DDD_2 + ( ABS DSX_1 ) ;
  18724. SIERR = SIERR + ( ( SIONE * L_Y ) * ( A_1 * DMX_1 / IXX_1 )) ;
  18725. MESS ' >>>>>>>fin sierr2 ' ;
  18726. FINSI ;
  18727. SI ( IGENE EGA 0 ) ;
  18728. QUITTER BODEPG ;
  18729. MESS ' >>>>>>>AUCUNE CONDITION DE DEFO GENE ' ;
  18730. MESS ' >>>>>>>CALCUL EFFECTUE EN PLAN ' ;
  18731. FINSI ;
  18732. SI ( IB >EG 2 ) ;
  18733. SI ( DDD_1 &lt;EG TOL_1 ) ; QUITTER BODEPG ; FINSI ;
  18734. SI ( DDD_2 &lt;EG TOL_2 ) ; QUITTER BODEPG ; FINSI ;
  18735. FINSI ;
  18736. MESS ' >>>>>>>on reboucle ' ;
  18737. FIN BODEPG ;
  18738. SIG1 = SI_13 ;
  18739. *ALPH1 = CHAN 'STRESSES' ( EXCO 'ALPH' MAT1 ) ;
  18740. *EPT = ALPH1 * ( PRCH TE1 ASCU1 'STRESSES' ) ;
  18741. ALPH1 = CHAN 'CHPO' ( EXCO 'ALPH' MAT1 ) ;
  18742. EPT = PRCH ( TE1 * ALPH1 ) ASCU1 'STRESSES' ;
  18743. *list EPT ;
  18744. ETXX = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPXX' EPT ;
  18745. ETYY = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPYY' EPT ;
  18746. ETZZ = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPZZ' EPT ;
  18747. CHEPS = ( ELAS SI_13 MAT1 ) + ETXX + ETYY + ETZZ ;
  18748. EPSZZ = EXCO EPZZ CHEPS ;
  18749. EPZM = ( INTG EPSZZ ) / SEC_1 ;
  18750. MESS ' VOTRE EPZ MOYEN : ' EPZM ;
  18751. EPBZ = EPSZZ - (( EPSZZ ** 0 ) * EPZM ) ;
  18752. SI ( EXISTE TABDEP1 MX ) ;
  18753. CHRY = L_Y * ( EPBZ ** -1 ) * -1. ;
  18754. MESS ' MAXI MINI DE VOTRE RY QUI DEVRAIT ETRE CONSTANT ' ( MAXI CHRY ) ( MINI CHRY ) ;
  18755. RY = ( INTG CHRY ) / SEC_1 ;
  18756. TABDEP1.'RY' = RY ;
  18757. FINSI ;
  18758. TABDEP1.'EPSI' = CHEPS ;
  18759. TABDEP1.'EPZM' = EPZM ;
  18760. FINPROC DE1 SIG1 ;
  18761. **** @resflux
  18762. debproc @resflux cht1*chpoint geo1*maillage geo2*maillage lambda1/flottant cara1/mchaml mod1*mmodel ;
  18763. mess '---------------------------------> calling @RESFLUX';
  18764. v1 = vale dime ;
  18765. *
  18766. * --- calcul du flux
  18767. *
  18768. si (exis lambda1) ;
  18769. lambda2 = lambda1 ;
  18770. sinon ;
  18771. si (exis cara1) ;
  18772. lambda2 = vari nuag mod1 (redu cara1 mod1) cht1 ;
  18773. lambda3 = chan chpo lambda2 mod1 ;
  18774. lambda4 = chan attribut lambda3 nature discret ;
  18775. lambda5 = exco lambda4 'K' ;
  18776. lambda1 = lambda5 ;
  18777. sinon ;
  18778. erre '>@resflux> NO CONDUCTIVITY' ;
  18779. finsi ;
  18780. finsi ;
  18781.  
  18782. gradt1 = grad cht1 mod1 ;
  18783. gradt2 = chan chpo gradt1 mod1 ;
  18784. gradt3 = chan attribut gradt2 nature discret ;
  18785. gradt4 = gradt3 * lambda1 ;
  18786. *
  18787. * --- calcul des normales
  18788. *
  18789. cosdir1 cosdir2 cosdir3 = @vnorm3d geo2 geo1 ;
  18790. cosdir1 = chan attribut cosdir1 nature discret ;
  18791. cosdir2 = chan attribut cosdir2 nature discret ;
  18792. cosdir3 = chan attribut cosdir3 nature discret ;
  18793. *
  18794. * --- produit scalaire
  18795. *
  18796. si (ega v1 2) ;
  18797. mess '>@resflux> 2D value in (W/m)' ;
  18798. flux1 = ((cosdir1 * (exco gradt4 'T,X')) + (cosdir2 * (exco gradt4 'T,Y')) );
  18799. sinon ;
  18800. mess '>@resflux> 3D value in (W)' ;
  18801. flux1 = ((cosdir1 * (exco gradt4 'T,X')) + (cosdir2 * (exco gradt4 'T,Y')) + (cosdir3 * (exco gradt4 'T,Z')) );
  18802. finsi ;
  18803. *
  18804. * --- intégration
  18805. *
  18806. flux2 = chan cham geo1 flux1 noeud ;
  18807. puis1 = intg (MODL geo1 thermique isotrope) flux2;
  18808. puis1 = abs puis1;
  18809. *
  18810. * --- affichage et fin
  18811. *
  18812. mess '>@resflux> Power through ligne or surface :' puis1 ;
  18813. mess '---------------------------------> exiting @RESFLUX';
  18814. finproc puis1 ;
  18815. **** RESI
  18816. *************************************************************
  18817. * PROCEDURE RESI : CALCUL D'UNE RESISTANCE
  18818. *************************************************************
  18819. DEBPROC RESI TAB1*TABLE ;
  18820. *************************************************************
  18821. * MODELE
  18822. *************************************************************
  18823. MOD1 = TABLE ;
  18824. MAT1 = TABLE ;
  18825. COND1 = TABLE ;
  18826. TMAIL = TAB1.MAILLAGE ;
  18827. TCOND = TAB1.CONDUCT ;
  18828. TELEC = TAB1.ELECTRO ;
  18829. I = 0 ;
  18830. REPETER BOUC1 100 ;
  18831. I = I + 1 ;
  18832. SI (EXIS TMAIL I) ;
  18833. MOD1.I = MODE TMAIL.I THERMIQUE ISOTROPE ;
  18834. MAT1.I = MATE MOD1.I 'K' TCOND.I ;
  18835. COND1.I = COND MOD1.I MAT1.I ;
  18836. SINON ;
  18837. QUITTER BOUC1 ;
  18838. FINSI ;
  18839. FIN BOUC1 ;
  18840. N1 = I - 1 ;
  18841. MESS 'NOMBRE DE MATERIAUX DIFFERENTS :' N1 ;
  18842. *MESS 'CONDUCTIVITES :' ;
  18843. *LIST COND1 ;
  18844. ****************************************************************
  18845. * CONDITIONS AUX LIMITES
  18846. *****************************************************************
  18847. T1 = 1. ;
  18848. T2 = 0. ;
  18849. EL1 = TELEC.1 ;
  18850. EL2 = TELEC.2 ;
  18851. CL1 = BLOQUE T EL1 ;
  18852. CL2 = BLOQUE T EL2 ;
  18853. TI1 = DEPI CL1 T1 ;
  18854. TI2 = DEPI CL2 T2 ;
  18855. ***************************************************************
  18856. * CHARGEMENT
  18857. ***************************************************************
  18858. COUR = TI1 ET TI2 ;
  18859. *****************************************************************
  18860. * RESOLUTION
  18861. *****************************************************************
  18862. AMP1 = 5.E-3 ;
  18863. I = 0 ;
  18864. REPETER BOUC2 N1 ;
  18865. I = I + 1 ;
  18866. SI (EGA I 1);
  18867. CONDT = COND1.1 ;
  18868. MOD1T = MOD1.I ;
  18869. TCONDT = MANU CHPO TMAIL.I 1 SCAL TCOND.I ;
  18870. UNIT = MANU CHPO TMAIL.I 1 SCAL 1. ;
  18871.  
  18872. SINON ;
  18873. CONDT = CONDT ET COND1.I ;
  18874. MOD1T = MOD1T ET MOD1.I ;
  18875. TCONDT =TCONDT ET ( MANU CHPO TMAIL.I 1 SCAL TCOND.I );
  18876. UNIT =UNIT ET ( MANU CHPO TMAIL.I 1 SCAL 1. ) ;
  18877. FINSI ;
  18878. TCONDT = TCONDT / UNIT ;
  18879. FIN BOUC2 ;
  18880. GEO = EXTR CONDT MAIL ;
  18881. RIG1 = CONDT ET CL1 ET CL2 ;
  18882. TEMP1 = RESOU RIG1 COUR ;
  18883. IDIM = VALEUR DIME ;
  18884. SI (EGA IDIM 2) ;
  18885. * TRAC TEMP1 GEO (CONT GEO) ;
  18886. SINON ;
  18887. OEIL1 = 1.E4 1.E4 1.E4 ;
  18888. * TRAC OEIL1 TEMP1 GEO (ENVE GEO) ;
  18889. FINSI ;
  18890. TAB1.GRADIENT = TABLE ;
  18891. GRAD1 = TAB1.GRADIENT ;
  18892. I = 0 ;
  18893. REPETER BOUC3 N1 ;
  18894. I = I + 1 ;
  18895. TEMPI = REDU TEMP1 TMAIL.I ;
  18896. GRAD1.I = (CHAN CHPO MOD1.I ( GRAD MOD1.I TEMPI )) * (-1. * TCOND.I) ;
  18897. SI (EGA I 1);
  18898. MOD1T = MOD1.I ;
  18899. TMAILT = TMAIL.I ;
  18900. GRADT = GRAD1.1 ;
  18901. SINON ;
  18902. MOD1T = MOD1T ET MOD1.I ;
  18903. TMAILT = TMAILT ET TMAIL.I ;
  18904. GRADT = GRADT ET GRAD1.I ;
  18905. FINSI ;
  18906. FIN BOUC3 ;
  18907. *GRADT = (CHAN CHPO MOD1T ( GRAD MOD1T TEMP1 )) *
  18908. *(-1. * TCOND.I) ;
  18909. GRADT = GRADT / UNIT ;
  18910. ***************************************************
  18911. *******
  18912. * CALCUL DU FLUX
  18913. *****************************************************************
  18914. I = 0 ;
  18915. TCH = EXTR GRADT COMP ;
  18916. TCH1 = EXTR TCH 1 ;
  18917. TCH2 = EXTR TCH 2 ;
  18918. **CHX = EXCO TCH1 GRADT JX ;
  18919. **CHY = EXCO TCH2 GRADT JY ;
  18920. SI (EGA IDIM 3) ;
  18921. J1 = ( EXCO TCH1 GRADT JX ) ET ( EXCO TCH2 GRADT JY ) ET ( EXCO TCH3 GRADT JZ ) ;
  18922. SINON ;
  18923. SI (EGA (VALEUR MODE) AXIS) ;
  18924. MESS ' CALCUL EN AXISYMETRIQUE' ;
  18925. MESS ' LA DENSITE DE COURANT EST DONNEE PAR RADIAN' ;
  18926. CHR = COOR 1 GEO ;
  18927. * CCHR = EXTR CHR COMP ;
  18928. * LCHR = MOTS CCHR.1 ;
  18929. * LCHX = MOTS JX ;
  18930. * LCHY = MOTS JY ;
  18931. * CHX = PSCA CHX CHR LCHX LCHR ;
  18932. * CHY = PSCA CHY CHR LCHY LCHR ;
  18933. * CHX = NOMC JX CHX ;
  18934. * CHY = NOMC JY CHY ;
  18935. * J1 = CHX ET CHY ;
  18936. * J1 = ( ( EXCO TCH1 GRADT JX ) * CHR )
  18937. * ET ( ( EXCO TCH2 GRADT JY ) * CHR ) ;
  18938. J1 = ( EXCO TCH1 GRADT JX ) ET ( EXCO TCH2 GRADT JY ) ;
  18939. SINON ;
  18940. J1 = ( EXCO TCH1 GRADT JX ) ET ( EXCO TCH2 GRADT JY ) ;
  18941. FINSI ;
  18942. FINSI ;
  18943. * SI (EGA IDIM 3) ;
  18944. * CHZ = EXCO TCH3 GRADT JZ ;
  18945. * J1 = J1 ET CHZ ;
  18946. * FINSI ;
  18947. REPETER BOUC9 N1 ;
  18948. I = I + 1 ;
  18949. SI (EGA IDIM 3) ;
  18950. GRAD1.I = ( EXCO TCH1 GRAD1.I JX ) ET ( EXCO TCH2 GRAD1.I JY ) ET ( EXCO TCH3 GRAD1.I JZ ) ;
  18951. SINON ;
  18952. SI (EGA (VALEUR MODE) AXIS) ;
  18953. GRAD1.I = ( ( EXCO TCH1 GRAD1.I JX ) * CHR ) ET ( ( EXCO TCH2 GRAD1.I JY ) * CHR ) ;
  18954. SINON ;
  18955. GRAD1.I = ( EXCO TCH1 GRAD1.I JX ) ET ( EXCO TCH2 GRAD1.I JY ) ;
  18956. FINSI ;
  18957. FINSI ;
  18958. FIN BOUC9 ;
  18959. GRAD2 = CHAM EL2 (REDU GRADT EL2) ;
  18960. GEO3 = GEO ELEM APPUYE LARGEMENT EL2 ;
  18961. MODE3 = MODE GEO3 MECANIQUE ELASTIQUE COQ2 TRI3 TRI6 QUA4 QUA8 ;
  18962. SI (EGA IDIM 2) ;
  18963. MODE3 = MODE GEO3 MECANIQUE ELASTIQUE COQ2 TRI3 TRI6 QUA4 QUA8 ;
  18964. SINON ;
  18965. MODE3 = MODE GEO3 MECANIQUE ELASTIQUE CUB8 CU20 TET4 TE10 PRI6 PR15 PYR5 PY13 ;
  18966. FINSI ;
  18967. CHP1 = PRES MASS MODE3 -1. EL2 ;
  18968. TC1 = EXTR CHP1 COMP ;
  18969. TC11 = EXTR TC1 1 ;
  18970. TC12 = EXTR TC1 2 ;
  18971. X1 = EXCO TC11 CHP1 SCAL ;
  18972. Y1 = EXCO TC12 CHP1 SCAL ;
  18973. ALPHA = ATG Y1 X1 ;
  18974. SI (EGA IDIM 2) ;
  18975. CHXN = NOMC 'NX' (COS ALPHA) ;
  18976. CHYN = NOMC 'NY' (SIN ALPHA) ;
  18977. CHN = CHXN + CHYN ;
  18978. SINON ;
  18979. TC13 = EXTR TC1 3 ;
  18980. Z1 = EXCO TC13 CHP1 SCAL ;
  18981. R1 = Y1/(SIN ALPHA) ;
  18982. PHI ATG Z1 R1 ;
  18983. CHXN = NOMC 'NX' ((COS PHI) * (COS ALPHA)) ;
  18984. CHYN = NOMC 'NY' ((COS PHI) * (SIN ALPHA)) ;
  18985. CHZN = NOMC 'NZ' (SIN PHI) ;
  18986. CHN = CHXN + CHYN + CHZN ;
  18987. FINSI ;
  18988. CJ1 = EXTR J1 COMP ;
  18989. CJ11 = EXTR CJ1 1 ;
  18990. CJ12 = EXTR CJ1 2 ;
  18991. CCH1 = EXTR CHN COMP ;
  18992. CCH11 = EXTR CCH1 1 ;
  18993. CCH12 = EXTR CCH1 2 ;
  18994. SI (EGA IDIM 2) ;
  18995. LJ1 = MOTS CJ11 CJ12;
  18996. LCHN = MOTS CCH11 CCH12;
  18997. SINON;
  18998. CJ13 = EXTR CJ1 3 ;
  18999. CCH13 = EXTR CCH1 3 ;
  19000. LJ1 = MOTS CJ11 CJ12 CJ13 ;
  19001. LCHN = MOTS CCH11 CCH12 CCH13;
  19002. FINSI ;
  19003. *LIST LJ1 ;
  19004. *LIST LCHN ;
  19005. CHFLUX = PSCA J1 CHN LJ1 LCHN ;
  19006. CHAMFLUX = CHAN CHAM CHFLUX EL2;
  19007. MO1 = MODE EL2 THERMIQUE ISOTROPE ;
  19008. FLUX1 = INTG MO1 CHAMFLUX ;
  19009. *****************************************************************
  19010. * CALCUL DE LA RESISTANCE
  19011. *****************************************************************
  19012. SI (EGA (VALEUR MODE) AXIS) ;
  19013. PI = 3.14159 ;
  19014. FLUX1 = FLUX1 * (2. * PI) ;
  19015. FINSI ;
  19016. RES1 = (T1 - T2) / FLUX1;
  19017. FINPROC TEMP1 J1 RES1 ;
  19018. *
  19019. DEBPROC @RIPPL TAB1*TABLE ;
  19020. *
  19021. ***********************************************************
  19022. * Version amelioree de la procedure RIPPLE *
  19023. * Alain MOAL (mai 1995) *
  19024. ***********************************************************
  19025. *
  19026. OPTI ECHO 1 ;
  19027. SAUT 2 LIGNE ;
  19028. MESS ' ********** DEBUT DE LA PROCEDURE @RIPPL ***********' ;
  19029. *
  19030. *--------------- VARIABLES D'ENTREE :
  19031. RHO0 = TAB1.<RPLASMA ;
  19032. RPLASMA = TAB1.<RPLASMA ;
  19033. THETA2 = TAB1.<THETA2 ;
  19034. THETA1 = TAB1.<THETA1 ;
  19035. COEF_A1 = TAB1.<COEF_A1 ;
  19036. COEF_B1 = TAB1.<COEF_B1 ;
  19037. COEF_C1 = TAB1.<COEF_C1 ;
  19038. RZERO = TAB1.<R0 ;
  19039. RREF = TAB1.<RREF ;
  19040. CONT1 = TAB1.<CONT ;
  19041. LSIN2T = TAB1.<CONTFIN ;
  19042. CONTFIN1 = TAB1.<CONTFIN ;
  19043. PRHO = TAB1.<PRHO ;
  19044. POINTTOP = TAB1.<PTOP ;
  19045. *------------------------------------
  19046. *---- nombre de bobines
  19047. NBOB = 18. ;
  19048. *
  19049. *---- l'utilite de ce masque ne m'apparait pas clairement
  19050. MASC1 = PRHO MASQUE EGSUPE (RPLASMA - 1.E-3) ;
  19051. PRHO1 = PROG ;
  19052. PDRHO1 = PROG ;
  19053. PRHO2 = PROG ;
  19054. PDRHO2 = PROG ;
  19055. *
  19056. *---- coordonnees polaires dans Rref de l'enveloppe des lignes
  19057. *---- de champ dans le plan Phi = 0
  19058. PRHO2 = ((RPLASMA * MASC1 * (SIN(THETA1)) / (SIN(THETA2))) + ((PRHO - (RPLASMA * MASC1)) / (COS(THETA1 - THETA2)))) ;
  19059. *
  19060. *---- demi-excursion radiale dans Rref
  19061. PDRHO2 = COEF_A1 * (EXP(COEF_B1 *PRHO2)) * (EXP(-1. * COEF_C1 * ((THETA2)**2))) ;
  19062. *
  19063. *---- coordonnees polaires dans Rzero de l'enveloppe des lignes
  19064. *---- de champ dans le plan Phi = 0
  19065. PRHO1 = (((((RREF - RZERO)**2) * MASC1) + (2 * (COS(THETA2)) * (RREF - RZERO) * PRHO2) + ((PRHO2)**2))**0.5) ;
  19066. *
  19067. *---- demi-excursion radiale dans Rzero
  19068. PDRHO1 = (PRHO2 + (MASC1 * (COS(THETA2)) * (RREF - RZERO))) / PRHO1 * PDRHO2 ;
  19069. *---- demi-excursion radiale dans Rzero
  19070. *TEST*PDRHO1 = (PRHO2 + (MASC1 * (COS(THETA2)) * (RREF - RZERO))) /
  19071. *TEST* PRHO * PDRHO2 ;
  19072. *
  19073. *LIST PRHO1 ;
  19074. *LIST PDRHO1 ;
  19075. *
  19076. *---- coordonnees des noeuds du contour
  19077. XCONT1 = COOR 1 CONT1 ;
  19078. YCONT1 = COOR 2 CONT1 ;
  19079. XCONTF1 = COOR 1 CONTFIN1 ;
  19080. YCONTF1 = COOR 2 CONTFIN1 ;
  19081. *
  19082. *---- on doit utiliser un contour constitue de segments a
  19083. *---- 2 noeuds pour le calcul des abcisses curvilignes
  19084. CONT2 = CHAN SEG2 CONT1 ;
  19085. CONTFIN2 = CHAN SEG2 CONTFIN1 ;
  19086. *
  19087. *---- abscisse curviligne pour chaque noeud du contour
  19088. XCUR = EXTR (EVOL CHPO XCONT1 SCAL (INVE CONT1)) ABSC ;
  19089. XCURF = EXTR (EVOL CHPO XCONTF1 SCAL (INVE CONTFIN1)) ABSC ;
  19090. *
  19091. *---- creation du champ a partir de la liste de reels
  19092. CHXCUR = MANU CHPO (INVE CONT2) 1 SCAL XCUR ;
  19093. CHXCURF = MANU CHPO (INVE CONTFIN2) 1 SCAL XCURF ;
  19094. *
  19095. *---- recherche du point extreme en X du contour on suppose
  19096. *---- qu'il est unique et que tous les X sont positifs
  19097. XEXT = MAXI (XCONT1) ;
  19098. PEXT = (XCONT1 POIN MAXI) POIN INITIAL ;
  19099. YEXT = COOR 2 PEXT ;
  19100. *
  19101. LAM0 = RPLASMA - RHO0 ;
  19102. PLAM = PROG LAM0 ;
  19103. PYPL1 = PROG 0. ;
  19104. PXVE = PROG 1.E-3 ;
  19105. PYVE = PROG 0. ;
  19106. I1 = 0 ;
  19107. *
  19108. *---- Pour chaque enveloppe de ligne de champ
  19109. REPETER BOUCL (DIME PRHO1) ;
  19110. I1 = I1 + 1 ;
  19111. *TEST* RHO1 = EXTR I1 PRHO ;
  19112. RHO1 = EXTR I1 PRHO1 ;
  19113. DRHO1 = EXTR I1 PDRHO1 ;
  19114. * MESS 'DRHO1 ' DRHO1 ;
  19115. DENS 3.E-3 ;
  19116. * --- Creation de la ligne de champ
  19117. S1 = 0. (RPLASMA - RHO1) ;
  19118. S2 = (XEXT + (XEXT/10.)) (RPLASMA - RHO1) ;
  19119. LSIN1 = S1 D S2 ;
  19120. XLS1 = COOR 1 LSIN1 ;
  19121. * --- ancien calcul : valable si THETA1 est proche de 90 degres
  19122. * DY1 = -1. * DRHO1 *
  19123. * (COS(XLS1 * (NBOB / RZERO / 3.14159 * 180.)) - 1.) ;
  19124. * --- calcul dans le cas general
  19125. * --- determination iterative de Phi et DY1
  19126. * DY1_OLD = -1. * DRHO1 ;
  19127. * I = 0 ;
  19128. * IMAX = 50 ;
  19129. * REPETER BOUCLE IMAX ;
  19130. * I = I + 1 ;
  19131. * PHI = ATG (XLS1 / ((RHO1*(COS THETA1))+ RZERO + DY1_OLD));
  19132. * DY1_NEW = -1. * DRHO1 * ((COS(PHI * NBOB)) - 1.) ;
  19133. * SI ((MAXI (ABS((DY1_NEW - DY1_OLD) / DY1_NEW))) &lt;EG 1.E-6);
  19134. * MESS ' NOMBRE D ITERATIONS DE POINT FIXE : ' I ;
  19135. * QUITTER BOUCLE ;
  19136. * FINSI ;
  19137. * DY1_OLD = DY1_NEW ;
  19138. * FIN BOUCLE ;
  19139. * DY1 = DY1_NEW ;
  19140. * ---
  19141. PHI = ATG (XLS1 / ((RHO1*(COS THETA1))+ RZERO)) ;
  19142. DY1 = -1. * DRHO1 * ((COS(PHI * NBOB)) - 1.) ;
  19143. DY2 = NOMC UY DY1 ;
  19144. LSIN2 = LSIN1 PLUS DY2 ;
  19145. * --- ligne contenant le contour et le sinus utilisee pour le trace
  19146. LSIN2T = LSIN2T ET LSIN2 ;
  19147. *
  19148. * --------- CALCUL DU POINT D'INTERSECTION
  19149. P_1 = LSIN2 POIN INITIAL ;
  19150. *
  19151. REPETER BOUCP 10 ;
  19152. EL_1 = ELEM LSIN2 CONTENANT P_1 ;
  19153. P_11 = POIN 1 EL_1 ;
  19154. P_12 = POIN 2 EL_1 ;
  19155. XV1 = COOR 1 (P_11 MOIN P_12) ;
  19156. YV1 = COOR 2 (P_11 MOIN P_12) ;
  19157. XV2 = (COOR 1 CONTFIN1) - (COOR 1 P_12);
  19158. YV2 = (COOR 2 CONTFIN2) - (COOR 2 P_12);
  19159. DIST =(ABS((YV2 * XV1) - (XV2 * YV1)))/(NORM (P_11 MOIN P_12));
  19160. PL_1 = (DIST POIN MINI) POIN INITIAL ;
  19161. P_1OLD = P_1 ;
  19162. P_1 = LSIN2 POIN PROC PL_1 ;
  19163. * TRAC (CONTFIN1 ET ((P_11 D 1 P_12) COUL ROUG) ET PL_1 ET LSIN2);
  19164. SI (P_1OLD EGA P_1 0.3E-3) ;
  19165. MESS ' >>> ON TROUVE LE POINT D INTERSEC. << ' ;
  19166. LIST PL_1 ;
  19167. QUITTER BOUCP ;
  19168. FINSI ;
  19169. FIN BOUCP ;
  19170. *
  19171. MESS ' ON EST SORTI DE BOUCP ' ;
  19172. X_11 = COOR 1 P_11 ;
  19173. X_12 = COOR 1 P_12 ;
  19174. SI ((X_12 - X_11) >EG 0.) ;
  19175. VEC_1 = P_12 MOIN P_11 ;
  19176. SINON ;
  19177. VEC_1 = P_11 MOIN P_12 ;
  19178. FINSI ;
  19179. YPL1 = COOR 2 PL_1 ;
  19180. XPL1 = COOR 1 PL_1 ;
  19181. * ---- abscisse curviligne de ce point
  19182. XC_PL_1 = MAXI (REDU CHXCURF PL_1) ;
  19183. PYPL1 = PYPL1 ET (PROG XC_PL_1) ;
  19184. PXVE = PXVE ET (PROG (COOR 1 VEC_1)) ;
  19185. PYVE = PYVE ET (PROG (COOR 2 VEC_1)) ;
  19186. PLAM = PLAM ET (PROG (RPLASMA - RHO1)) ;
  19187. FIN BOUCL ;
  19188. *
  19189. *---- traitement du dernier point du contour
  19190. POINFIN = (INVE CONT1) POIN FINAL ;
  19191. XC_FIN = MAXI (REDU CHXCUR POINFIN) ;
  19192. PYPL1 = PYPL1 ET (PROG (XC_FIN + (XC_FIN/10.))) ;
  19193. PXVE = PXVE ET (PROG 1.E-3) ;
  19194. PYVE = PYVE ET (PROG 0.) ;
  19195. DYMAX = -1. * (MAXI(ABS(YCONT1))) ;
  19196. PLAM = PLAM ET (PROG DYMAX) ;
  19197. *
  19198. *------ Trace du contour et des lignes de champ
  19199. TITRE ' ENVELOPPES DES LIGNES DE CHAMP ' ;
  19200. TRAC LSIN2T ;
  19201. TITRE 'ABCISSE CURVILIGNE' ;
  19202. DESSIN (EVOL JAUN CHPO CHXCUR SCAL CONT1) MIMA ;
  19203. CHXVE = NOMC SCAL (IPOL CHXCUR PYPL1 PXVE) ;
  19204. CHYVE = NOMC SCAL (IPOL CHXCUR PYPL1 PYVE) ;
  19205. TITRE 'BETA' ;
  19206. BETA = ATG CHYVE CHXVE ;
  19207. DESSIN (EVOL JAUN CHPO BETA SCAL CONT1) MIMA ;
  19208. TITRE 'DISTANCE' ;
  19209. CHDEL = NOMC SCAL (IPOL CHXCUR PYPL1 PLAM) ;
  19210. DESSIN (EVOL JAUN CHPO CHDEL SCAL CONT1) MIMA ;
  19211. *
  19212. *--------------- VARIABLES DE SORTIE :
  19213. TAB1.<BETA = BETA ;
  19214. TAB1.<DIST = CHDEL ;
  19215. *------------------------------------
  19216. *
  19217. SAUT 2 LIGNE ;
  19218. MESS ' ********** FIN DE LA PROCEDURE @RIPPL ***********' ;
  19219. FINPROC ;
  19220. *
  19221. DEBPROC @RIPPL TAB1*TABLE ;
  19222. *
  19223. ***********************************************************
  19224. * Version amelioree de l'ancienne procedure RIPPLE *
  19225. * Alain MOAL (mai 1995) *
  19226. ***********************************************************
  19227. *
  19228. OPTI ECHO 1 ;
  19229. SAUT 2 LIGNE ;
  19230. MESS ' ********** DEBUT DE LA PROCEDURE @RIPPL ***********' ;
  19231. *
  19232. *--------------- VARIABLES D'ENTREE :
  19233. RHO0 = TAB1.<RPLASMA ;
  19234. RPLASMA = TAB1.<RPLASMA ;
  19235. THETA2 = TAB1.<THETA2 ;
  19236. THETA1 = TAB1.<THETA1 ;
  19237. COEF_A1 = TAB1.<COEF_A1 ;
  19238. COEF_B1 = TAB1.<COEF_B1 ;
  19239. COEF_C1 = TAB1.<COEF_C1 ;
  19240. RZERO = TAB1.<R0 ;
  19241. RREF = TAB1.<RREF ;
  19242. CONT1 = TAB1.<CONT ;
  19243. LSIN2T = TAB1.<CONTFIN ;
  19244. CONTFIN1 = TAB1.<CONTFIN ;
  19245. PRHO = TAB1.<PRHO ;
  19246. POINTTOP = TAB1.<PTOP ;
  19247. *------------------------------------
  19248. *---- nombre de bobines
  19249. NBOB = 18. ;
  19250. *
  19251. *---- l'utilite de ce masque ne m'apparait pas clairement
  19252. MASC1 = PRHO MASQUE EGSUPE (RPLASMA - 1.E-3) ;
  19253. PRHO1 = PROG ;
  19254. PDRHO1 = PROG ;
  19255. PRHO2 = PROG ;
  19256. PDRHO2 = PROG ;
  19257. *
  19258. *---- coordonnees polaires dans Rref de l'enveloppe des lignes
  19259. *---- de champ dans le plan Phi = 0
  19260. PRHO2 = ((RPLASMA * MASC1 * (SIN(THETA1)) / (SIN(THETA2))) + ((PRHO - (RPLASMA * MASC1)) / (COS(THETA1 - THETA2)))) ;
  19261. *
  19262. *---- demi-excursion radiale dans Rref
  19263. PDRHO2 = COEF_A1 * (EXP(COEF_B1 *PRHO2)) * (EXP(-1. * COEF_C1 * ((THETA2)**2))) ;
  19264. *
  19265. *---- coordonnees polaires dans Rzero de l'enveloppe des lignes
  19266. *---- de champ dans le plan Phi = 0
  19267. PRHO1 = (((((RREF - RZERO)**2) * MASC1) + (2 * (COS(THETA2)) * (RREF - RZERO) * PRHO2) + ((PRHO2)**2))**0.5) ;
  19268. *
  19269. *---- demi-excursion radiale dans Rzero
  19270. PDRHO1 = (PRHO2 + (MASC1 * (COS(THETA2)) * (RREF - RZERO))) / PRHO1 * PDRHO2 ;
  19271. *---- demi-excursion radiale dans Rzero
  19272. *TEST*PDRHO1 = (PRHO2 + (MASC1 * (COS(THETA2)) * (RREF - RZERO))) /
  19273. *TEST* PRHO * PDRHO2 ;
  19274. *
  19275. *LIST PRHO1 ;
  19276. *LIST PDRHO1 ;
  19277. *
  19278. *---- coordonnees des noeuds du contour
  19279. XCONT1 = COOR 1 CONT1 ;
  19280. YCONT1 = COOR 2 CONT1 ;
  19281. XCONTF1 = COOR 1 CONTFIN1 ;
  19282. YCONTF1 = COOR 2 CONTFIN1 ;
  19283. *
  19284. *---- on doit utiliser un contour constitue de segments a
  19285. *---- 2 noeuds pour le calcul des abcisses curvilignes
  19286. CONT2 = CHAN SEG2 CONT1 ;
  19287. CONTFIN2 = CHAN SEG2 CONTFIN1 ;
  19288. *
  19289. *---- abscisse curviligne pour chaque noeud du contour
  19290. XCUR = EXTR (EVOL CHPO XCONT1 SCAL (INVE CONT1)) ABSC ;
  19291. XCURF = EXTR (EVOL CHPO XCONTF1 SCAL (INVE CONTFIN1)) ABSC ;
  19292. *
  19293. *---- creation du champ a partir de la liste de reels
  19294. CHXCUR = MANU CHPO (INVE CONT2) 1 SCAL XCUR ;
  19295. CHXCURF = MANU CHPO (INVE CONTFIN2) 1 SCAL XCURF ;
  19296. *
  19297. *---- recherche du point extreme en X du contour on suppose
  19298. *---- qu'il est unique et que tous les X sont positifs
  19299. XEXT = MAXI (XCONT1) ;
  19300. PEXT = (XCONT1 POIN MAXI) POIN INITIAL ;
  19301. YEXT = COOR 2 PEXT ;
  19302. *
  19303. LAM0 = RPLASMA - RHO0 ;
  19304. PLAM = PROG LAM0 ;
  19305. PYPL1 = PROG 0. ;
  19306. PXVE = PROG 1.E-3 ;
  19307. PYVE = PROG 0. ;
  19308. I1 = 0 ;
  19309. *
  19310. *---- Pour chaque enveloppe de ligne de champ
  19311. REPETER BOUCL (DIME PRHO1) ;
  19312. I1 = I1 + 1 ;
  19313. *TEST* RHO1 = EXTR I1 PRHO ;
  19314. RHO1 = EXTR I1 PRHO1 ;
  19315. DRHO1 = EXTR I1 PDRHO1 ;
  19316. * MESS 'DRHO1 ' DRHO1 ;
  19317. DENS 3.E-3 ;
  19318. * --- Creation de la ligne de champ
  19319. S1 = 0. (RPLASMA - RHO1) ;
  19320. S2 = (XEXT + (XEXT/10.)) (RPLASMA - RHO1) ;
  19321. LSIN1 = S1 D S2 ;
  19322. XLS1 = COOR 1 LSIN1 ;
  19323. * --- ancien calcul : valable si THETA1 est proche de 90 degres
  19324. * DY1 = -1. * DRHO1 *
  19325. * (COS(XLS1 * (NBOB / RZERO / 3.14159 * 180.)) - 1.) ;
  19326. * --- calcul dans le cas general
  19327. * --- determination iterative de Phi et DY1
  19328. * DY1_OLD = -1. * DRHO1 ;
  19329. * I = 0 ;
  19330. * IMAX = 50 ;
  19331. * REPETER BOUCLE IMAX ;
  19332. * I = I + 1 ;
  19333. * PHI = ATG (XLS1 / ((RHO1*(COS THETA1))+ RZERO + DY1_OLD));
  19334. * DY1_NEW = -1. * DRHO1 * ((COS(PHI * NBOB)) - 1.) ;
  19335. * SI ((MAXI (ABS((DY1_NEW - DY1_OLD) / DY1_NEW))) &lt;EG 1.E-6);
  19336. * MESS ' NOMBRE D ITERATIONS DE POINT FIXE : ' I ;
  19337. * QUITTER BOUCLE ;
  19338. * FINSI ;
  19339. * DY1_OLD = DY1_NEW ;
  19340. * FIN BOUCLE ;
  19341. * DY1 = DY1_NEW ;
  19342. * ---
  19343. PHI = ATG (XLS1 / ((RHO1*(COS THETA1))+ RZERO)) ;
  19344. DY1 = -1. * DRHO1 * ((COS(PHI * NBOB)) - 1.) ;
  19345. DY2 = NOMC UY DY1 ;
  19346. LSIN2 = LSIN1 PLUS DY2 ;
  19347. * --- ligne contenant le contour et le sinus utilisee pour le trace
  19348. LSIN2T = LSIN2T ET LSIN2 ;
  19349. *
  19350. * --------- CALCUL DU POINT D'INTERSECTION
  19351. P_1 = LSIN2 POIN INITIAL ;
  19352. *
  19353. REPETER BOUCP 10 ;
  19354. EL_1 = ELEM LSIN2 CONTENANT P_1 ;
  19355. P_11 = POIN 1 EL_1 ;
  19356. P_12 = POIN 2 EL_1 ;
  19357. XV1 = COOR 1 (P_11 MOIN P_12) ;
  19358. YV1 = COOR 2 (P_11 MOIN P_12) ;
  19359. XV2 = (COOR 1 CONTFIN1) - (COOR 1 P_12);
  19360. YV2 = (COOR 2 CONTFIN2) - (COOR 2 P_12);
  19361. DIST =(ABS((YV2 * XV1) - (XV2 * YV1)))/(NORM (P_11 MOIN P_12));
  19362. PL_1 = (DIST POIN MINI) POIN INITIAL ;
  19363. P_1OLD = P_1 ;
  19364. P_1 = LSIN2 POIN PROC PL_1 ;
  19365. * TRAC (CONTFIN1 ET ((P_11 D 1 P_12) COUL ROUG) ET PL_1 ET LSIN2);
  19366. SI (P_1OLD EGA P_1 0.3E-3) ;
  19367. MESS ' >>> ON TROUVE LE POINT D INTERSEC. << ' ;
  19368. LIST PL_1 ;
  19369. QUITTER BOUCP ;
  19370. FINSI ;
  19371. FIN BOUCP ;
  19372. *
  19373. MESS ' ON EST SORTI DE BOUCP ' ;
  19374. X_11 = COOR 1 P_11 ;
  19375. X_12 = COOR 1 P_12 ;
  19376. SI ((X_12 - X_11) >EG 0.) ;
  19377. VEC_1 = P_12 MOIN P_11 ;
  19378. SINON ;
  19379. VEC_1 = P_11 MOIN P_12 ;
  19380. FINSI ;
  19381. YPL1 = COOR 2 PL_1 ;
  19382. XPL1 = COOR 1 PL_1 ;
  19383. * ---- abscisse curviligne de ce point
  19384. XC_PL_1 = MAXI (REDU CHXCURF PL_1) ;
  19385. PYPL1 = PYPL1 ET (PROG XC_PL_1) ;
  19386. PXVE = PXVE ET (PROG (COOR 1 VEC_1)) ;
  19387. PYVE = PYVE ET (PROG (COOR 2 VEC_1)) ;
  19388. PLAM = PLAM ET (PROG (RPLASMA - RHO1)) ;
  19389. FIN BOUCL ;
  19390. *
  19391. *---- traitement du dernier point du contour
  19392. POINFIN = (INVE CONT1) POIN FINAL ;
  19393. XC_FIN = MAXI (REDU CHXCUR POINFIN) ;
  19394. PYPL1 = PYPL1 ET (PROG (XC_FIN + (XC_FIN/10.))) ;
  19395. PXVE = PXVE ET (PROG 1.E-3) ;
  19396. PYVE = PYVE ET (PROG 0.) ;
  19397. DYMAX = -1. * (MAXI(ABS(YCONT1))) ;
  19398. PLAM = PLAM ET (PROG DYMAX) ;
  19399. *
  19400. *------ Trace du contour et des lignes de champ
  19401. TITRE ' ENVELOPPES DES LIGNES DE CHAMP ' ;
  19402. TRAC LSIN2T ;
  19403. TITRE 'ABCISSE CURVILIGNE' ;
  19404. DESSIN (EVOL JAUN CHPO CHXCUR SCAL CONT1) MIMA ;
  19405. CHXVE = NOMC SCAL (IPOL CHXCUR PYPL1 PXVE) ;
  19406. CHYVE = NOMC SCAL (IPOL CHXCUR PYPL1 PYVE) ;
  19407. TITRE 'BETA' ;
  19408. BETA = ATG CHYVE CHXVE ;
  19409. DESSIN (EVOL JAUN CHPO BETA SCAL CONT1) MIMA ;
  19410. TITRE 'DISTANCE' ;
  19411. CHDEL = NOMC SCAL (IPOL CHXCUR PYPL1 PLAM) ;
  19412. DESSIN (EVOL JAUN CHPO CHDEL SCAL CONT1) MIMA ;
  19413. *
  19414. *--------------- VARIABLES DE SORTIE :
  19415. TAB1.<BETA = BETA ;
  19416. TAB1.<DIST = CHDEL ;
  19417. *------------------------------------
  19418. *
  19419. SAUT 2 LIGNE ;
  19420. MESS ' ********** FIN DE LA PROCEDURE @RIPPL ***********' ;
  19421. FINPROC ;
  19422. debproc @RMCOOR tab1*table ;
  19423.  
  19424. *
  19425. * R. Mitteau etude interseption
  19426. * 25/08/1998
  19427. *
  19428. mess '---------------------------------> calling @RMCOOR';
  19429. *
  19430. * --- variables d entree :
  19431. *
  19432. mail1 = tab1.<maillage ;
  19433.  
  19434.  
  19435. * RM25/08/98 la il faudrait mettre un test pour verfier qu'on
  19436. * entre bien un maillage surfacique compose uniquement de tri3
  19437.  
  19438. *chpo des coordonnee des noeuds
  19439. chx1 = coor 1 mail1 ;
  19440. chy1 = coor 2 mail1 ;
  19441. chz1 = coor 3 mail1 ;
  19442.  
  19443. mod1 = MODE mail1 mecanique elastique ;
  19444. *cham des coordonnees des noeuds
  19445. cex1 = chan cham chx1 mod1 noeud ;
  19446. cey1 = chan cham chy1 mod1 noeud ;
  19447. cez1 = chan cham chz1 mod1 noeud ;
  19448.  
  19449. nel1 = nbel mail1 ;
  19450. mess '>@RMCOOR> construction des champs de coordonnees sur les ' nel1 ' elements';
  19451. * initialisation
  19452. chamx1 = manu chml mod1 scal 0. stresses type scalaire ;
  19453. chamx2 = manu chml mod1 scal 0. stresses type scalaire ;
  19454. chamx3 = manu chml mod1 scal 0. stresses type scalaire ;
  19455. chamy1 = manu chml mod1 scal 0. stresses type scalaire ;
  19456. chamy2 = manu chml mod1 scal 0. stresses type scalaire ;
  19457. chamy3 = manu chml mod1 scal 0. stresses type scalaire ;
  19458. chamz1 = manu chml mod1 scal 0. stresses type scalaire ;
  19459. chamz2 = manu chml mod1 scal 0. stresses type scalaire ;
  19460. chamz3 = manu chml mod1 scal 0. stresses type scalaire ;
  19461.  
  19462. repe boucel1 nel1 ;
  19463. * mess &boucel1 ;
  19464.  
  19465. cex1_1 = extr cex1 scal 1 &boucel1 1 ;
  19466. cex1_2 = extr cex1 scal 1 &boucel1 2 ;
  19467. cex1_3 = extr cex1 scal 1 &boucel1 3 ;
  19468.  
  19469. cey1_1 = extr cey1 scal 1 &boucel1 1 ;
  19470. cey1_2 = extr cey1 scal 1 &boucel1 2 ;
  19471. cey1_3 = extr cey1 scal 1 &boucel1 3 ;
  19472.  
  19473. cez1_1 = extr cez1 scal 1 &boucel1 1 ;
  19474. cez1_2 = extr cez1 scal 1 &boucel1 2 ;
  19475. cez1_3 = extr cez1 scal 1 &boucel1 3 ;
  19476.  
  19477. chamx1 = chamx1 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_1);
  19478. chamx2 = chamx2 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_2);
  19479. chamx3 = chamx3 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_3);
  19480.  
  19481. chamy1 = chamy1 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_1);
  19482. chamy2 = chamy2 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_2);
  19483. chamy3 = chamy3 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_3);
  19484.  
  19485. chamz1 = chamz1 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_1);
  19486. chamz2 = chamz2 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_2);
  19487. chamz3 = chamz3 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_3);
  19488. fin boucel1 ;
  19489. *
  19490. * --- variables de sortie
  19491. *
  19492. tab1.<chamx1 = chamx1 ;
  19493. tab1.<chamy1 = chamy1 ;
  19494. tab1.<chamz1 = chamz1 ;
  19495. tab1.<chamx2 = chamx2 ;
  19496. tab1.<chamy2 = chamy2 ;
  19497. tab1.<chamz2 = chamz2 ;
  19498. tab1.<chamx3 = chamx3 ;
  19499. tab1.<chamy3 = chamy3 ;
  19500. tab1.<chamz3 = chamz3 ;
  19501.  
  19502.  
  19503. mess '---------------------------------> exiting @RMCOOR';
  19504. finproc ;
  19505.  
  19506. **** @RMCOORO
  19507.  
  19508. debproc @RMCOORO tab1*table ;
  19509.  
  19510. *
  19511. * R. Mitteau etude interseption
  19512. * 25/08/1998
  19513. *
  19514. mess '---------------------------------> calling @RMCOORO';
  19515. *
  19516. * --- variables d entree :
  19517. *
  19518. mail1 = tab1.<maillage ;
  19519.  
  19520.  
  19521. * RM25/08/98 la il faudrait mettre un test pour verifier qu'on
  19522. * entre bien un maillage surfacique compose uniquement de tri3
  19523.  
  19524. * chpo des coordonnee des noeuds dans le repere du maillage
  19525. chxm1 = coor 1 mail1 ;
  19526. chym1 = coor 2 mail1 ;
  19527. chzm1 = coor 3 mail1 ;
  19528.  
  19529. * passage au repere global
  19530. chxg1 chyg1 chzg1 = @crmgc chxm1 chym1 chzm1 tab1;
  19531.  
  19532. mod1 = MODE mail1 mecanique elastique ;
  19533. * cham des coordonnees des noeuds
  19534. cex1 = chan cham chxg1 mod1 noeud ;
  19535. cey1 = chan cham chyg1 mod1 noeud ;
  19536. cez1 = chan cham chzg1 mod1 noeud ;
  19537.  
  19538. nel1 = nbel mail1 ;
  19539. mess '>@RMCOORO> construction des champs de coordonnees sur les ' nel1 ' elements';
  19540. * initialisation
  19541. chamx1 = manu chml mod1 scal 0. stresses type scalaire ;
  19542. chamx2 = manu chml mod1 scal 0. stresses type scalaire ;
  19543. chamx3 = manu chml mod1 scal 0. stresses type scalaire ;
  19544. chamy1 = manu chml mod1 scal 0. stresses type scalaire ;
  19545. chamy2 = manu chml mod1 scal 0. stresses type scalaire ;
  19546. chamy3 = manu chml mod1 scal 0. stresses type scalaire ;
  19547. chamz1 = manu chml mod1 scal 0. stresses type scalaire ;
  19548. chamz2 = manu chml mod1 scal 0. stresses type scalaire ;
  19549. chamz3 = manu chml mod1 scal 0. stresses type scalaire ;
  19550.  
  19551. repe boucel1 nel1 ;
  19552.  
  19553. cex1_1 = extr cex1 scal 1 &boucel1 1 ;
  19554. cex1_2 = extr cex1 scal 1 &boucel1 2 ;
  19555. cex1_3 = extr cex1 scal 1 &boucel1 3 ;
  19556.  
  19557. cey1_1 = extr cey1 scal 1 &boucel1 1 ;
  19558. cey1_2 = extr cey1 scal 1 &boucel1 2 ;
  19559. cey1_3 = extr cey1 scal 1 &boucel1 3 ;
  19560.  
  19561. cez1_1 = extr cez1 scal 1 &boucel1 1 ;
  19562. cez1_2 = extr cez1 scal 1 &boucel1 2 ;
  19563. cez1_3 = extr cez1 scal 1 &boucel1 3 ;
  19564.  
  19565. chamx1 = chamx1 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_1);
  19566. chamx2 = chamx2 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_2);
  19567. chamx3 = chamx3 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_3);
  19568.  
  19569. chamy1 = chamy1 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_1);
  19570. chamy2 = chamy2 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_2);
  19571. chamy3 = chamy3 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_3);
  19572.  
  19573. chamz1 = chamz1 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_1);
  19574. chamz2 = chamz2 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_2);
  19575. chamz3 = chamz3 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_3);
  19576. fin boucel1 ;
  19577. *
  19578. * --- variables de sortie
  19579. *
  19580. tab1.<chamx1 = chamx1 ;
  19581. tab1.<chamy1 = chamy1 ;
  19582. tab1.<chamz1 = chamz1 ;
  19583. tab1.<chamx2 = chamx2 ;
  19584. tab1.<chamy2 = chamy2 ;
  19585. tab1.<chamz2 = chamz2 ;
  19586. tab1.<chamx3 = chamx3 ;
  19587. tab1.<chamy3 = chamy3 ;
  19588. tab1.<chamz3 = chamz3 ;
  19589.  
  19590.  
  19591. mess '---------------------------------> exiting @RMCOORO';
  19592. finproc ;
  19593.  
  19594. **** @RMFLUN
  19595.  
  19596. debproc @RMFLUN tab1*table ;
  19597. ************************************************************
  19598. * Procedure de calcul du flux normalise en chaque noeud de *
  19599. * chaque facette triangulaire d'un maillage (methode *
  19600. * inspiree de @RMCOORO). Alain MOAL (Fevrier 2001) *
  19601. ************************************************************
  19602.  
  19603. mess '---------------------------------> calling @RMFLUN';
  19604. *
  19605. * --- variables d entree :
  19606. FLUN0 = TAB1.<FLUX_NORMALISE ;
  19607. MAIL1 = TAB1.<MAILLAGE ;
  19608. * ------------------------
  19609.  
  19610. mod1 = MODE mail1 mecanique elastique ;
  19611. * --- cham du flux normalise
  19612. cef0 = chan cham FLUN0 mod1 noeud ;
  19613.  
  19614. nel1 = nbel mail1 ;
  19615. mess '>@RMFLUN> construction du champ de flux normalise sur les ' nel1 ' elements';
  19616. * initialisation
  19617. chamf1 = manu chml mod1 scal 0. stresses type scalaire ;
  19618. chamf2 = manu chml mod1 scal 0. stresses type scalaire ;
  19619. chamf3 = manu chml mod1 scal 0. stresses type scalaire ;
  19620.  
  19621. repe boucel1 nel1 ;
  19622. cef0_1 = extr cef0 scal 1 &boucel1 1 ;
  19623. cef0_2 = extr cef0 scal 1 &boucel1 2 ;
  19624. cef0_3 = extr cef0 scal 1 &boucel1 3 ;
  19625.  
  19626. chamf1 = chamf1 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cef0_1);
  19627. chamf2 = chamf2 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cef0_2);
  19628. chamf3 = chamf3 + (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cef0_3);
  19629. fin boucel1 ;
  19630. *
  19631. * --- variables de sortie
  19632. tab1.<chamf1 = chamf1 ;
  19633. tab1.<chamf2 = chamf2 ;
  19634. tab1.<chamf3 = chamf3 ;
  19635. *
  19636. mess '---------------------------------> exiting @RMFLUN';
  19637. finproc ;
  19638.  
  19639. **** @RMNORM
  19640. debproc @RMNORM tab1*table ;
  19641.  
  19642. mess '---------------------------------> calling @RMNORM';
  19643. *
  19644. * --- variables d entree :
  19645. *
  19646. si (non (existe tab1 <chamx1)) ;
  19647. @rmcoor tab1;
  19648. finsi ;
  19649.  
  19650. * calcul des normales
  19651.  
  19652. * (on pourrait peut etre utiliser VNORM3D. Mais il faut noter
  19653. * qu on veut ici les normales au centre des facettes et non aux noeuds.
  19654. * On profite du fait qu on a ici que des triangles pour utiliser
  19655. * le produit vectoriel de deux cotes du triangle)
  19656.  
  19657. abx1 = (tab1.<chamx2) - (tab1.<chamx1) ;
  19658. acx1 = (tab1.<chamx3) - (tab1.<chamx1) ;
  19659.  
  19660. aby1 = (tab1.<chamy2) - (tab1.<chamy1) ;
  19661. acy1 = (tab1.<chamy3) - (tab1.<chamy1) ;
  19662.  
  19663. abz1 = (tab1.<chamz2) - (tab1.<chamz1) ;
  19664. acz1 = (tab1.<chamz3) - (tab1.<chamz1) ;
  19665.  
  19666.  
  19667. nx1 = (aby1*acz1) - (abz1*acy1) ;
  19668. ny1 = (abz1*acx1) - (abx1*acz1) ;
  19669. nz1 = (abx1*acy1) - (aby1*acx1) ;
  19670.  
  19671. * normalisation
  19672.  
  19673. nor1 = ((nx1 * nx1) + (ny1 * ny1) + (nz1 * nz1)) ** .5 ;
  19674. si (ega (mini nor1) 0.);
  19675. mess '>>>@RMNORM>>> la norme d une des normales est nulle';
  19676. mess '>>>@RMNORM>>> peut-etre maillage n est pas forme de tri3';
  19677. erre '>>>@RMNORM>>> erreur de maillage';
  19678. finsi ;
  19679. nx2 = nx1 * (nor1 ** -1) ;
  19680. ny2 = ny1 * (nor1 ** -1) ;
  19681. nz2 = nz1 * (nor1 ** -1) ;
  19682.  
  19683. *
  19684. * --- variables de sortie
  19685. *
  19686. tab1.<cosx = nx2 ;
  19687. tab1.<cosy = ny2 ;
  19688. tab1.<cosz = nz2 ;
  19689.  
  19690.  
  19691. mess '---------------------------------> exiting @RMNORM';
  19692. finproc ;
  19693.  
  19694. **** @RPOI
  19695. DEBPROC @RPOI LPOINT*MAILLAGE NPOIN*LISTMOTS LSHAF1*MAILLAGE CPLASMA*POINT >PTG*POINT TAB1*TABLE ;
  19696. LSHAF0 = LSHAF1 ET >PTG ;
  19697. TRAC (LPOINT ET >PTG ET CPLASMA ET LSHAF0) ;
  19698. XM = COOR 1 LSHAF0 ;
  19699. YM = COOR 2 LSHAF0 ;
  19700. ZM = XM * 0. ;
  19701. XG YG ZG = @CRMGC XM YM ZM TAB1 ;
  19702. RHOP THETAP PHIP = @CRGTC XG YG ZG TAB1.<RP TAB1.<HP;
  19703. GRAY PRAY THERAY = @CSHIFT RHOP THETAP PHIP 1 TAB1;
  19704. LIGRAY0 = CPLASMA D 1 >PTG ;
  19705. * MESS 'POINT : >PTG' ;
  19706. LNOM = MOTS 'PTG' ;
  19707. PRAY0 = EXTR PRAY SCAL >PTG ;
  19708. GRAY0 = EXTR GRAY SCAL >PTG ;
  19709. LPR1 = PROG PRAY0;
  19710. LGR1 = PROG GRAY0 ;
  19711. LINC10 = >PTG ;
  19712. CHPR1 = MANU CHPO >PTG 1 SCAL PRAY0 NATURE DISCRET;
  19713. CHGR1 = MANU CHPO >PTG 1 SCAL GRAY0 NATURE DISCRET;
  19714. MESS 'POINT >PTG PRAY0' PRAY0 'GRAY0' GRAY0 ;
  19715. I = 0 ;
  19716. CP1 = CPLASMA ;
  19717. TAN1 = >PTG;
  19718. POI1 = >PTG;
  19719. REPETER BOUC21 10;
  19720. POI1 = POI1 TOUR 2. CP1 ;
  19721. TAN1 = TAN1 D 1 POI1;
  19722. FIN BOUC21 ;
  19723. TAN1 = INVE TAN1 ;
  19724. POI1 = >PTG;
  19725. REPETER BOUC31 10;
  19726. POI1 = POI1 TOUR -2. CP1 ;
  19727. TAN1 = TAN1 D 1 POI1;
  19728. FIN BOUC31 ;
  19729. TAN3 = TAN1 COUL BLEU ;
  19730. TRAC (TAN3 ET (CP1 D 1 >PTG)) ;
  19731. MCO1 = MOTS ROUG ROSE JAUN VERT TURQ BLAN BLEU ;
  19732. REPETER BOUCLE1 (NBNO LPOINT);
  19733. I = I + 1 ;
  19734. POINT0 = LPOINT POIN I ;
  19735. NOMP = NPOIN EXTR I ;
  19736. * MESS 'POINT :' NOMP;
  19737. LNOM = LNOM ET (MOTS NOMP) ;
  19738. GRAY1 = EXTR GRAY SCAL POINT0 ;
  19739. PRAY1 = EXTR PRAY SCAL POINT0 ;
  19740. LPR1 = LPR1 ET (PROG PRAY1) ;
  19741. LGR1 = LGR1 ET (PROG GRAY1) ;
  19742. CHPR1 = CHPR1 ET (MANU CHPO POINT0 1 SCAL PRAY0 NATURE DISCRET);
  19743. CHGR1 = CHGR1 ET (MANU CHPO POINT0 1 SCAL GRAY0 NATURE DISCRET);
  19744.  
  19745. I1 = I - (I / 7 * 7) ;
  19746. * ---- centre du cercle dans le repere du maillage
  19747. CP1 = ((COOR 1 CPLASMA) + (GRAY1-GRAY0)) (COOR 2 CPLASMA);
  19748. LIGRAY1 = (CP1 D 1 POINT0) COUL (MCO1 EXTR I1) ;
  19749. LIGRAY0 = LIGRAY0 ET LIGRAY1 ;
  19750. MESS 'POINT ' NOMP ' PRAY1 ' PRAY1 'GRAY1' GRAY1 ;
  19751.  
  19752. * POINT1 = POINT0;
  19753. TAN1 = POINT0 ;
  19754. POI1 = POINT0 ;
  19755. REPETER BOUC2 10;
  19756. POI2 = POI1 TOUR 2. CP1 ;
  19757. TAN1 = TAN1 D 1 POI2;
  19758. POI1 = POI2 ;
  19759. FIN BOUC2 ;
  19760. * POINT1 = POINT0;
  19761. TAN1 = INVE TAN1 ;
  19762. POI1 = POINT0 ;
  19763. REPETER BOUC3 10;
  19764. POI2 = POI1 TOUR -2. CP1 ;
  19765. TAN1 = TAN1 D 1 POI2;
  19766. POI1 = POI2 ;
  19767. FIN BOUC3 ;
  19768. TAN2 = TAN1 COUL (MCO1 EXTR I1);
  19769. TAN3 = TAN3 ET TAN2;
  19770. TRAC (TAN2 ET (CP1 D 1 POINT0)) ;
  19771. FIN BOUCLE1;
  19772. list LNOM ;
  19773. list LPR1 ;
  19774. list LGR1 ;
  19775. *NTAB CHPR1;
  19776. *NTAB CHGR1;
  19777. FINPROC TAN3 LIGRAY0 ;
  19778.  
  19779. **** @SCHINTE
  19780. DEBPROC @SCHINTE LSIN2*MAILLAGE LPA21*MAILLAGE EPS3*FLOTTANT PP_1/POINT ;
  19781. MESS '-----------------------------------> entree dans @SCHINTE ';
  19782. SI ( NON (EXISTE PP_1 )) ;
  19783. P_1 = LSIN2 POIN INITIAL ;
  19784. SINON ;
  19785. P_1 = LSIN2 POIN PROC PP_1 ;
  19786. FINSI ;
  19787. I__1 = 0 ;
  19788. REPETER BOUCP 10 ;
  19789. I__1 = I__1 + 1 ;
  19790. EPS2 = EPS3 ;
  19791. EL_1 = ELEM LSIN2 CONTENANT P_1 ;
  19792. P_11 = POIN 1 EL_1 ;
  19793. P_12 = POIN 2 EL_1 ;
  19794. * trac ( LPA21 ET ( P_11 D P_12 )) ;
  19795. PL_1 = LPA21 POIN DROIT P_11 P_12 EPS2 ;
  19796. I__2 = 0 ;
  19797. REPETER BOUCI 10 ;
  19798. I__2 = I__2 + 1 ;
  19799. NBP1= NBNO PL_1 ;
  19800. SI (NBP1 >EG 3 ) ;
  19801. EPS2 = EPS2 / 1.7 ;
  19802. * EPS2 = EPS2 / 1.9 ;
  19803. MESS I__1 I__2 ' ** NB PTS , EPS2 : ' NBP1 EPS2 ;
  19804. PL_1 = LPA21 POIN DROIT P_11 P_12 EPS2 ;
  19805. SINON ;
  19806. QUITTER BOUCI ;
  19807. FINSI ;
  19808. FIN BOUCI ;
  19809. NBP1= NBNO PL_1 ;
  19810. PL_1 = PL_1 POIN 1 ;
  19811. P_1OLD = P_1 ;
  19812. P_1 = LSIN2 POIN PROC PL_1 ;
  19813. SI ( P_1OLD EGA P_1 0.3E-3 ) ;
  19814. MESS '@SCHINTE >>> ON TROUVE LE POINT D INTERSEC. << ' ;
  19815. LIST PL_1 ;
  19816. QUITTER BOUCP ;
  19817. FINSI ;
  19818. FIN BOUCP ;
  19819. MESS '@SCHINTE>> ON EST SORTI DE BOUCP ' ;
  19820. * P_12 MOIN P_11 EST LA TANGENTE ;
  19821. X_11 = COOR 1 P_11 ;
  19822. X_12 = COOR 1 P_12 ;
  19823. SI ( (X_12 - X_11) >EG 0. ) ;
  19824. VEC_1 = P_12 MOIN P_11 ;
  19825. SINON ;
  19826. VEC_1 = P_11 MOIN P_12 ;
  19827. FINSI ;
  19828. MESS '-----------------------------------> sortie de @SCHINTE ';
  19829. FINPROC PL_1 VEC_1 ;
  19830.  
  19831. DEBPROC @SHIFT RHO*CHPOINT THETA*CHPOINT PHI*CHPOINT TAB1*TABLE ;
  19832. *
  19833. **************************************************************
  19834. * Procedure de calcul des grand et petit rayons du "cercle *
  19835. * de Shafranov" en chaque point defini dans le repere centre *
  19836. * sur le plasma. Alain MOAL (juin 1995) *
  19837. **************************************************************
  19838. *
  19839. OPTI ECHO 0 ;
  19840. *
  19841. *--------------- VARIABLES D'ENTREE :
  19842. RP = TAB1.<RP ;
  19843. RHO0 = TAB1.<RHO0 ;
  19844. LAMB = TAB1.<LAMB ;
  19845. *------------------------------------
  19846. *
  19847. *---- on se ramene a la resolution d'une equation du 2nd degre
  19848. *---- variables auxiliaires
  19849. AUX1 = 1. + LAMB ;
  19850. AUX2 = RHO * (COS THETA) + RP ;
  19851. AUX3 = RHO * (SIN THETA) ;
  19852. DELTA = ((AUX2**2) * (AUX1**2)) - ((AUX1 + 1.) * ( ((AUX2**2) + (AUX3**2)) * AUX1 - (RP**2) - ((RHO0**2) * AUX1))) ;
  19853. *
  19854. *---- deux cercles possibles
  19855. GRANDR1 = ((AUX2 * AUX1) + (DELTA**0.5))/(AUX1 + 1.) ;
  19856. GRANDR2 = ((AUX2 * AUX1) - (DELTA**0.5))/(AUX1 + 1.) ;
  19857. *
  19858. *---- choix du bon cercle
  19859. SI ((COS THETA) >EG 0.) ;
  19860. GRANDR = GRANDR2 ;
  19861. SINON ;
  19862. GRANDR = GRANDR1 ;
  19863. FINSI ;
  19864. *
  19865. *---- calcul du petit rayon
  19866. PETITR = ((AUX2 - GRANDR)**2 + (AUX3**2))**0.5 ;
  19867. *
  19868. *---- calcul de theta dans le repere centre sur le cercle calcule
  19869. THETAR = ATG AUX3 (AUX2 - GRANDR) ;
  19870. *
  19871. FINPROC GRANDR PETITR THETAR;
  19872. **** @TABEAU
  19873. *********************************************************
  19874. ****** PROCEDURE @TABEAU ******
  19875. *********************************************************
  19876. * CARACTERISTIQUES DE L EAU
  19877. *--------------------------------------------------------
  19878. DEBPROC @TABEAU L_TRAC/LOGIQUE TAB_1*TABLE ;
  19879. SI ( NON ( EXISTE L_TRAC )) ;
  19880. L_TRAC = FAUX ;
  19881. FINSI ;
  19882. *
  19883. *
  19884. *--- PARAMETRES
  19885. *
  19886. * ORIGINE : Properties of Water and Steam in SI-Units
  19887. * prepared by Ernst Schmidt ( 0-800C / 0-1000 bar)
  19888. * edited by Ulrich Grigull 1979
  19889. *
  19890. *--- TSAT (C) EN FONCTION DE LA PRESSION (Pa)
  19891. *
  19892. 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 ;
  19893. 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 ;
  19894. TAB_1 . EPTSAT = EVOL MANU 'PRESSION' PPSAT 'TEMPERATURE' PTSAT ;
  19895. *
  19896. *--- LISTE DES TEMPERATURES DE SATURATION (C)
  19897. *
  19898. PTSAT = PROG 0. 20. 40. 60. 80. 100. 120. 140. 160. 180. 200. 220. 240. 260. 280. 300. ;
  19899. *
  19900. *--- LISTE DES TEMPERATURES (C)
  19901. *
  19902. PTEMP = PROG 0. 20. 40. 60. 80. 100. 120. 140. 160. 180. 200. 220. 240. 260. 280. 300. ;
  19903. *
  19904. *--- RHO DE L'EAU (kg/m3) EN FONCTION DE LA TEMPERATURE
  19905. *
  19906. 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 ;
  19907. TAB_1 . ETRHOF = EVOL MANU 'TEMPERATURE' PTEMP 'MASSEVOLUM' PRHOF ;
  19908. *
  19909. *--- RHO DE LA VAPEUR(kg/m3) A TSAT PSAT EN FONCTION DE TSAT
  19910. *
  19911. 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 ;
  19912. TAB_1 . ETRHOG = EVOL MANU 'TEMPERATURE' PTSAT 'MASSEVOLUM' PRHOG ;
  19913. *
  19914. *--- ENTHALPIE DE L'EAU (J/kg) EN FONCTION DE LA TEMPERATURE
  19915. *
  19916. 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 ;
  19917. TAB_1 . ETHF = EVOL MANU 'TEMPERATURE' PTEMP 'ENTHALPIE' PHF ;
  19918. TAB_1 . EHFT = EVOL MANU 'ENTHALPIE' PHF 'TEMPERATURE' PTEMP ;
  19919. *
  19920. *--- CHALEUR LATENTE DE VAP. DE L'EAU (J/kg) EN FONCTION DE LA TEMP.
  19921. * ;
  19922. 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;
  19923. TAB_1 . ETHFG = EVOL MANU 'TEMPERATURE' PTEMP 'CH_L_VAP' PHFG ;
  19924. *
  19925. *--- ENTHALPIE DE LA VAPEUR (J/kg) A TSAT PSAT EN FONCTION DE TSAT
  19926. *
  19927. PHG = PHFG + PHF ;
  19928. TAB_1 . ETHG = EVOL MANU 'TEMPERATURE' PTSAT 'ENTH_VAPEUR' PHG ;
  19929. *
  19930. *--- TENSION SURFACIQUE (kg/m2s2) EN FONCTION DE LA TEMPERATURE
  19931. *
  19932. 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;
  19933. TAB_1 . ETSIGM = EVOL MANU 'TEMPERATURE' PTEMP 'TENS_SURF' PSIGM ;
  19934. *
  19935. * ORIGINE : Heat Transfer Physical Properties
  19936. * from E.R.G. Eckert and R.M. Drake
  19937. * Analysis of Heat Mass Transfer McGraw-Hill New-York 1972
  19938. *
  19939. *--- LISTE DES TEMPERATURES (C)
  19940. *
  19941. PTEM1 = PROG 0. 20. 40. 60. 80. 100. 120. 140. 160. 180. 200. 220. 240. 260. 280.6 300. ;
  19942. *
  19943. *--- PRANDTL DE L'EAU EN FONCTION DE LA TEMPERATURE
  19944. *
  19945. 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 ;
  19946. TAB_1 . ETPRAF = EVOL MANU 'TEMPERATURE' PTEM1 'PRANDTL' PPRAF ;
  19947. *
  19948. *--- VISCOSITE DE L'EAU (kg/ms) EN FONCTION DE LA TEMPERATURE
  19949. *
  19950. 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 ;
  19951. TAB_1 . ETNNU = EVOL MANU 'TEMPERATURE' PTEM1 'VISCOSITE' PNNU ;
  19952. *
  19953. *--- LAMBDA DE L EAU (W/mK) EN FONCTION DE LA TEMPERATURE
  19954. *
  19955. PLLA = PROG .552 .597 .628 .651 .668 .680 .685 .684 .680 .675 .665 .652 .635 .611 .580 .540 ;
  19956. TAB_1 . ETLLA = EVOL MANU 'TEMPERATURE' PTEM1 'LAMBDA_EAU' PLLA ;
  19957. *
  19958. *--- Cp DE L EAU (J/kg.C) EN FONCTION DE LA TEMPERATURE
  19959. *
  19960. PCPF = PROG 4217.8 4181.8 4178.4 4184.3 4196.4 4216.1 4250 4283 4342 4417 4505 4610 4756 4949 5208 5728 ;
  19961. TAB_1 . ETCPF = EVOL MANU 'TEMPERATURE' PTEM1 'Cp_EAU' PCPF ;
  19962. *
  19963. * ORIGINE : Handbook of Heat Transfer ( McGraw-Hill)
  19964. * Rohsenow and Hartnett ( p 7-5 )
  19965. * Diagramme de Moody
  19966. *
  19967. *--- COEF DE FROTTEMENT EN FONCTION DU NOMBRE DE REYNOLDS
  19968. *--- POUR UNE PAROI LISSE
  19969. *
  19970. PRE = PROG 4.E3 6.E3 9.E3 2.E4 6.E4 1.E5 2.E5 1.E6 3.E6 1.E7 ;
  19971. PCF = PROG 0.01 0.009 0.008 0.006 0.005 0.0045 0.004 0.003 0.0023 0.002 ;
  19972. TAB_1.ETF = EVOL MANU 'REYNOLDS' PRE 'COEFFROT' PCF ;
  19973. *
  19974. SI L_TRAC ;
  19975. DESSIN TAB_1.EPTSAT ;
  19976. DESSIN TAB_1.ETRHOF ;
  19977. DESSIN TAB_1.ETRHOG ;
  19978. DESSIN TAB_1.ETPRAF ;
  19979. DESSIN TAB_1.ETNNU ;
  19980. DESSIN ( TAB_1.ETHF ET TAB_1.ETHG ) ;
  19981. DESSIN ( TAB_1.ETHFG ) ;
  19982. DESSIN TAB_1.ETLLA ;
  19983. DESSIN TAB_1.ETF ;
  19984. FINSI ;
  19985. FINPROC ;
  19986. **** @TESTGEO
  19987.  
  19988. DEBPROC @TESTGEO TAB1*TABLE ;
  19989.  
  19990. MESS '---------------------------------> calling @TESTGEO';
  19991. MESS 'METHODE GEOMETRIQUE' ;
  19992. *
  19993. *--------------- VARIABLES D'ENTREE :
  19994. *
  19995.  
  19996. MAIL1 = TAB1.<S_OMBRE ;
  19997. OMB0 = TAB1.<S_OMBRANT ;
  19998. IMETHOD = TAB1.<METHODE_REMONTEE ;
  19999. chsign1 = tab1.<chsign ;
  20000.  
  20001. TYPCAL = TAB1.<TYPE_CALCUL ;
  20002. RP = TAB1.<RP ;
  20003. RHO0 = TAB1.<RHO0 ;
  20004. RR = TAB1.<RR ;
  20005. HP = TAB1.<HP ;
  20006. EPS0 = TAB1.<EPS ;
  20007. COEFA = TAB1.<COEFA ;
  20008. COEFB = TAB1.<COEFB ;
  20009. COEFC = TAB1.<COEFC ;
  20010. NBOB = TAB1.<NBOB ;
  20011.  
  20012. PASB2 = TAB1.<PAS_AVEC_TEST ;
  20013. DMAX2 = TAB1.<DIST_AVEC_TEST ;
  20014. NBPAS2 = TAB1.<NBPAS2 ;
  20015.  
  20016. SI (EXIS TAB1 <PAS_SANS_TEST) ;
  20017. PASB1 = TAB1.<PAS_SANS_TEST ;
  20018. DMAX1 = TAB1.<DIST_SANS_TEST ;
  20019. NBPAS1 = TAB1.<NBPAS1 ;
  20020. FINSI ;
  20021.  
  20022. SI ((VALEUR DIME) EGA 2) ;
  20023. IPLAN = TAB1.<PLAN ;
  20024. FINSI ;
  20025.  
  20026. SI (EXIS TAB1 <SAUV_PTS_OMBRANTS) ;
  20027. REPO = TAB1.<SAUV_PTS_OMBRANTS ;
  20028. SINON;
  20029. REPO = FAUX;
  20030. FINSI ;
  20031.  
  20032. *
  20033. * ---
  20034. *
  20035.  
  20036. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  20037. ISHIFT = VRAI ;
  20038. IRIPPLE = VRAI ;
  20039. FINSI ;
  20040. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  20041. ISHIFT = VRAI ;
  20042. IRIPPLE = FAUX ;
  20043. FINSI ;
  20044. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  20045. ISHIFT = FAUX ;
  20046. IRIPPLE = VRAI ;
  20047. FINSI ;
  20048. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  20049. ISHIFT = FAUX ;
  20050. IRIPPLE = FAUX ;
  20051. FINSI ;
  20052. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  20053. ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
  20054. FINSI ;
  20055.  
  20056. *xm ym zm = coor omb0 ;
  20057. *xg yg zg = @crmgc xm ym zm tab1 ;
  20058. *rho theta phi = @crgtc xg yg zg rp hp ;
  20059. *rhomax = maxi rho ;
  20060. *rhomin = mini rho ;
  20061. *thetamax = maxi theta ;
  20062. *thetamin = mini theta ;
  20063. *RM22/12/98 le test d'appartenance au domaine de validite du
  20064. * modele de ripple est fait dans ombrage
  20065. *
  20066. * -------------------------------------------------------------
  20067. *
  20068. * --- calcul de l'angle d'incidence maximal s'il n'a pas ete
  20069. * defini par l'utilisateur
  20070. *
  20071. SI (EXIS TAB1 <INCIDENCE_MAXIMALE) ;
  20072. ALPHA = TAB1.<INCIDENCE_MAXIMALE ;
  20073. SINON ;
  20074. ALPHA = @INCI TAB1 ;
  20075. TAB1.<INCIDENCE_MAXIMALE = ALPHA ;
  20076. FINSI ;
  20077. *
  20078. * --- calcul du critere d'intersection s'il n'a pas ete
  20079. * defini par l'utilisateur
  20080. *
  20081. SI (EXIS TAB1 <DELIM) ;
  20082. DELIM = TAB1.<DELIM ;
  20083. SINON ;
  20084. DELIM = @CRIT TAB1 ;
  20085. FINSI ;
  20086. *
  20087. * -------------------------------------------------------------
  20088. *
  20089. * --- DUPLICATION DU MAILLAGE OMBRE NON DEFORME
  20090. SI ((VALEUR DIME) EGA 3) ;
  20091. VNUL = 0. 0. 0. ;
  20092. SINON ;
  20093. VNUL = 0. 0. ;
  20094. FINSI ;
  20095. * --- MAILLAGE DE TRAVAIL => FORM
  20096. MAI1TRAV = MAIL1 PLUS VNUL ;
  20097.  
  20098. *
  20099. * --- PROJECTION DU CHAMP DE SIGNES SUR LE MAILLAGE DE TRAVAIL
  20100. * --- BOUCLE SUR CHAQUE POINT DU MAILLAGE DE TRAVAIL
  20101.  
  20102. MAIL1PT = CHAN MAI1TRAV POI1 ;
  20103. NBM1 = NBNO MAI1TRAV ;
  20104. PT1 = ELEM MAIL1PT POINT 1 ;
  20105. PP = MAIL1 POIN PROC PT1 ;
  20106. VAL1 = EXTR CHSIGN1 SCAL PP ;
  20107. MAILP1 = MANU POI1 PT1 ;
  20108. CHSIGTRA = MANU CHPO MAILP1 1 SCAL VAL1 'NATURE' DISCRET ;
  20109. REPETER BOUPI (NBM1 - 1) ;
  20110. I = &BOUPI + 1 ;
  20111. PTI = ELEM MAIL1PT POINT I ;
  20112. PPI = MAIL1 POIN PROC PTI ;
  20113. VALI = EXTR CHSIGN1 SCAL PPI ;
  20114. MAILPI = MANU POI1 PTI ;
  20115. CHI = MANU CHPO MAILPI 1 SCAL VALI 'NATURE' DISCRET ;
  20116. CHSIGTRA = CHSIGTRA ET CHI ;
  20117. FIN BOUPI ;
  20118. *BR 01/10/98 TAB1.<CHSIGN = CHSIGN ;
  20119. *
  20120. * #######################################################
  20121. *
  20122. *--- INITIALISATION DES PARAMETRES DE LA BOUCLE
  20123. *
  20124. * #######################################################
  20125. *
  20126. I1 = 0 ;
  20127. chelim = manu chpo MAI1TRAV 1 'SCAL' 0. nature discret ;
  20128. CHP1 = MANU CHPO MAI1TRAV 1 'SCAL' 1. NATURE DISCRET ;
  20129. CHDIST = MANU CHPO MAI1TRAV 1 'SCAL' 0. NATURE DISCRET ;
  20130. MASQ1 = CHELIM ;
  20131.  
  20132.  
  20133. * ---- VARIABLE POUR SAVOIR SI ON EFFECTUE LE VISAVIS OU NON
  20134. TVISA = VRAI ;
  20135.  
  20136. * ---- coordonnees dans le repere du maillage
  20137. XM0 = COOR 1 MAI1TRAV ;
  20138. YM0 = COOR 2 MAI1TRAV ;
  20139. DIM0 = VALEUR DIME ;
  20140. SI (DIM0 EGA 2) ;
  20141. ZM0 = XM0 * 0. ;
  20142. DNUL = XM0 * 0. ;
  20143. PHINUL = DNUL ;
  20144. THENUL = DNUL ;
  20145. VNUL = 0. 0. ;
  20146. SINON ;
  20147. ZM0 = COOR 3 MAI1TRAV ;
  20148. VNUL = 0. 0. 0. ;
  20149. FINSI ;
  20150.  
  20151. *---- Coordonnees dans le repere global du tore
  20152. XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
  20153.  
  20154. *---- CONSTRUCTION D'UN POINT REPONDANT AU CRITERE DE VISAVIS
  20155. PVISA = (OMB0 POIN INIT) PLUS VNUL ;
  20156.  
  20157. *---- Repere pour le trace
  20158. SI (DIM0 EGA 3) ;
  20159. repxyz = @REPERE (prog 0.1 0.1 0.1) VRAI rouge;
  20160. FINSI ;
  20161.  
  20162. *---- initialisation des distances
  20163. LCOURAN1 = 0. ;
  20164. LMAX1 = 0. ;
  20165.  
  20166.  
  20167. *
  20168. * --- Rappel des parametres de la procedure
  20169. *
  20170. MESS ' ';
  20171. MESS '##################################################';
  20172. MESS ' ';
  20173. MESS '>@TESTGEO> procedure OMBRAGE, Rappel des parametres de calcul ';
  20174. MESS ' ';
  20175.  
  20176. SI (IMETHOD EGA 1) ;
  20177. METH = 'methode explicite des tangentes';
  20178. FINSI ;
  20179. SI (IMETHOD EGA 2) ;
  20180. METH = 'methode moyenne des tangentes aux extremitee';
  20181. FINSI ;
  20182. SI (IMETHOD EGA 3) ;
  20183. METH = 'methode du point milieu';
  20184. FINSI ;
  20185. SI (IMETHOD EGA 4) ;
  20186. METH = 'methode de reprojection';
  20187. FINSI ;
  20188. MESS ' ';
  20189.  
  20190. SI (EXIS tab1 <PAS_SANS_TEST) ;
  20191. MESS 'Calcul en deux parties :';
  20192. MESS ' ';
  20193. MESS 'SANS TEST';
  20194. MESS 'Distance remontee :' DMAX1 ;
  20195. MESS 'Pas pour la remontee :' PASB1 ;
  20196. MESS 'Nombre d iterations :' NBPAS1 ;
  20197. MESS ' ';
  20198. MESS 'AVEC TEST';
  20199. MESS 'Distance remontee :' DMAX2 ;
  20200. MESS 'Pas pour la remontee :' PASB2 ;
  20201. MESS 'Nombre d iterations :' NBPAS2 ;
  20202. SINON ;
  20203. MESS 'Calcul avec test systematique :';
  20204. MESS 'Distance remontee :' DMAX2 ;
  20205. MESS 'Pas de remontee :' PASB2 ;
  20206. MESS 'Nombre d iterations :' NBPAS2 ;
  20207. FINSI ;
  20208. MESS ' ' ;
  20209. MESS 'Critere d interception pour VISAVIS :' DELIM ;
  20210. MESS 'Incidence maximale sur OMBRE en degres :' ALPHA ;
  20211.  
  20212. SI (EXIS TAB1 <NTRAC) ;
  20213. MESS 'AVEC 'TAB1.<NTRAC' TRACES INTERMEDIAIRES' ;
  20214. FINSI ;
  20215.  
  20216. SI (EXIS TAB1 <SAUV_PTS_OMBRANTS ) ;
  20217. SI TAB1.<SAUV_PTS_OMBRANTS ;
  20218. MESS 'Sauvegarde des points ombrants';
  20219. SINON ;
  20220. MESS 'pas de sauvegarde des points ombrants';
  20221. FINSI ;
  20222. SINON ;
  20223. MESS 'pas de sauvegarde des points ombrants';
  20224. FINSI ;
  20225.  
  20226. SI ISHIFT ;
  20227. MESS 'Calcul avec shift de Safranov' ;
  20228. SINON ;
  20229. MESS 'Calcul sans shift de Safranov';
  20230. FINSI ;
  20231.  
  20232. SI IRIPPLE ;
  20233. MESS 'Calcul avec ripple du champ toroidal' ;
  20234. SINON ;
  20235. MESS 'Calcul sans ripple du champ toroidal' ;
  20236. FINSI ;
  20237.  
  20238. MESS ' ';
  20239. MESS '##################################################';
  20240. MESS ' ';
  20241.  
  20242. SI (EXIS TAB1 <DIST_SANS_TEST) ;
  20243. PAR2 = FAUX ;
  20244. TVISA = FAUX ;
  20245. MESS 'PREMIERE PARTIE DU CALCUL, SANS VISAVIS';
  20246. NBPAS0 = NBPAS1 + NBPAS2 ;
  20247. SINON ;
  20248. NBPAS0 = NBPAS2 ;
  20249. FINSI ;
  20250.  
  20251. *
  20252. *--------------------------------------------------------------
  20253. *
  20254. * DEBUT DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  20255. *
  20256. *--------------------------------------------------------------
  20257. *
  20258. MESS ' ';
  20259. MESS '##################################################';
  20260. MESS ' ';
  20261.  
  20262.  
  20263. SI (EXIS TAB1 <DIST_SANS_TEST) ;
  20264.  
  20265. * ------------------ Boucle 1 on remonte sans test -------------------
  20266. PASB0 = PASB1 ;
  20267. * increment de la distance de connexion (= PAS tant qu'il n'y a pas
  20268. * d'intersection)
  20269. chdist9 = manu chpo MAI1TRAV 1 scal pasb0 ;
  20270.  
  20271. MESS 'PREMIERE PARTIE DU CALCUL, SANS TEST D INTERSECTION';
  20272. REPETER BOUCLE1 NBPAS1 ;
  20273. I1 = I1 + 1 ;
  20274. LCOURAN1 = LCOURAN1 + PASB0 ;
  20275. MESS ' ';
  20276. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  20277.  
  20278. * ---- Appel de la procedure de calcul des deplacements selon methode choisie
  20279. * ---- Methode Explicite
  20280. SI (IMETHOD EGA 1) ;
  20281. DEPX0 DEPY0 DEPZ0 = @DEXPLI XG_OLD YG_OLD ZG_OLD PASB0 TAB1;
  20282. FINSI ;
  20283. * ---- Methode Euler-Cauchy
  20284. SI (IMETHOD EGA 2) ;
  20285. DEPX0 DEPY0 DEPZ0 = @DMOYEN XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
  20286. FINSI ;
  20287. * ---- Methode Point Milieu Modifiee
  20288. SI (IMETHOD EGA 3) ;
  20289. DEPX0 DEPY0 DEPZ0 =@DMILIEU XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
  20290. FINSI ;
  20291. * ---- Methode de Reprojection
  20292. SI (IMETHOD EGA 4) ;
  20293. DEPX0 DEPY0 DEPZ0 =@DREPROJ XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
  20294. FINSI ;
  20295.  
  20296. * ---- On affecte le signe donnant le sens de remontee aux deplacements
  20297. DEPX0 = CHSIGTRA * DEPX0 ;
  20298. DEPY0 = CHSIGTRA * DEPY0 ;
  20299. DEPZ0 = CHSIGTRA * DEPZ0 ;
  20300.  
  20301. * ---- Calcul du deplacement projete selon le cas
  20302. SI (DIM0 EGA 2) ;
  20303. * ---- Calcul de TETA et PHI par @CRGTC
  20304. RHO THETA PHI = @CRGTC XG_OLD YG_OLD ZG_OLD RP HP ;
  20305.  
  20306. * ---- Projection par un double changement de base
  20307. SI (EGA IPLAN 'PHICONS') ;
  20308. DRO DTETA DPHI = @CBGTV DEPX0 DEPY0 DEPZ0 THETA PHI ;
  20309. PHINUL = DNUL ;
  20310. DEPXP DEPYP DEPZP = @CBTGV DRO DTETA DNUL THETA PHINUL;
  20311. SINON ;
  20312. DRO DTETA DPHI = @CBGTV DEPX0 DEPY0 DEPZ0 THETA PHI ;
  20313. THENUL = DNUL ;
  20314. DEPXP DEPYP DEPZP = @CBTGV DRO DNUL DPHI THENUL PHI ;
  20315. FINSI ;
  20316. FINSI ;
  20317.  
  20318. * ---- Cas 3D : Dprojete = D
  20319. SI (DIM0 EGA 3) ;
  20320. DEPXP DEPYP DEPZP = DEPX0 DEPY0 DEPZ0 ;
  20321. FINSI ;
  20322.  
  20323. * ---- On calcule les deplacements (projetes si 2D)
  20324. * ---- dans le repere du maillage pour le FORM
  20325. * ---- avec la procedure de changement de base
  20326. DX DY DZ = @CBGMV DEPXP DEPYP DEPZP TAB1 ;
  20327.  
  20328. DEPX1 = NOMC UX DX NATURE DIFFUS ;
  20329. DEPY1 = NOMC UY DY NATURE DIFFUS ;
  20330. DEPZ1 = NOMC UZ DZ NATURE DIFFUS ;
  20331.  
  20332. DEP1 = DEPX1 ET DEPY1 ET DEPZ1 ;
  20333. FORM DEP1 ;
  20334.  
  20335. * ---- Calcul analytique des nouvelles coordonnees dans le repere global
  20336. * (deplacements non projetes meme en 2D)
  20337.  
  20338. XG_NEW = XG_OLD + DEPX0 ;
  20339. YG_NEW = YG_OLD + DEPY0 ;
  20340. ZG_NEW = ZG_OLD + DEPZ0 ;
  20341.  
  20342. XG_OLD = XG_NEW ;
  20343. YG_OLD = YG_NEW ;
  20344. ZG_OLD = ZG_NEW ;
  20345.  
  20346.  
  20347. *--- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  20348. chdist = chdist + CHDIST9 ;
  20349.  
  20350.  
  20351.  
  20352.  
  20353. * --- actualisation des champs de coordonnees pour iteration suivante
  20354.  
  20355. XG_OLD = XG_NEW ;
  20356. YG_OLD = YG_NEW ;
  20357. ZG_OLD = ZG_NEW ;
  20358.  
  20359. FIN BOUCLE1 ;
  20360. * ------------------------ Fin de la boucle 1 ------------------------
  20361. finsi ;
  20362.  
  20363.  
  20364.  
  20365. MESS ' ';
  20366. MESS '##################################################';
  20367. MESS ' ';
  20368.  
  20369. MESS 'CALCUL AVEC TEST D INTERSECTION';
  20370.  
  20371. * ------------------ Boucle 2 on remonte avec test -------------------
  20372. PASB0 = PASB2 ;
  20373. REPETER BOUCLE2 NBPAS2 ;
  20374.  
  20375. I1 = I1 + 1 ;
  20376. LCOURAN1 = LCOURAN1 + PASB0 ;
  20377. MESS ' ';
  20378. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  20379.  
  20380.  
  20381. *---- Appel de la procedure de calcul des deplacements selon methode choisie
  20382. *---- Methode Explicite
  20383. SI (IMETHOD EGA 1) ;
  20384. DEPX0 DEPY0 DEPZ0 = @DEXPLI XG_OLD YG_OLD ZG_OLD PASB0 TAB1;
  20385. FINSI ;
  20386. *---- Methode Euler-Cauchy
  20387. SI (IMETHOD EGA 2) ;
  20388. DEPX0 DEPY0 DEPZ0 = @DMOYEN XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
  20389. FINSI ;
  20390. *---- Methode Point Milieu Modifiee
  20391. SI (IMETHOD EGA 3) ;
  20392. DEPX0 DEPY0 DEPZ0 = @DMILIEU XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
  20393. FINSI ;
  20394. *---- Methode de Reprojection
  20395. SI (IMETHOD EGA 4) ;
  20396. DEPX0 DEPY0 DEPZ0 = @DREPROJ XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
  20397. FINSI ;
  20398.  
  20399. *---- On affecte le signe donnant le sens de remontee aux deplacements
  20400. DEPX0 = CHSIGTRA * DEPX0 ;
  20401. DEPY0 = CHSIGTRA * DEPY0 ;
  20402. DEPZ0 = CHSIGTRA * DEPZ0 ;
  20403.  
  20404. *---- Calcul du deplacement projete selon le cas
  20405. SI (DIM0 EGA 2) ;
  20406. *---- Calcul de TETA et PHI par @CRGTC
  20407. RHO THETA PHI = @CRGTC XG_OLD YG_OLD ZG_OLD RP HP ;
  20408.  
  20409. *---- Projection par un double changement de base
  20410. SI (EGA IPLAN 'PHICONS') ;
  20411. DRO DTETA DPHI = @CBGTV DEPX0 DEPY0 DEPZ0 THETA PHI ;
  20412. PHINUL = DNUL ;
  20413. DEPXP DEPYP DEPZP = @CBTGV DRO DTETA DNUL THETA PHINUL;
  20414. SINON ;
  20415. DRO DTETA DPHI = @CBGTV DEPX0 DEPY0 DEPZ0 THETA PHI ;
  20416. THENUL = DNUL ;
  20417. DEPXP DEPYP DEPZP = @CBTGV DRO DNUL DPHI THENUL PHI ;
  20418. FINSI ;
  20419. FINSI ;
  20420.  
  20421. *---- Cas 3D : Dprojete = D
  20422. SI (DIM0 EGA 3) ;
  20423. DEPXP DEPYP DEPZP = DEPX0 DEPY0 DEPZ0 ;
  20424. FINSI ;
  20425.  
  20426. * ---- On calcule les deplacements (projetes si 2D)
  20427. * ---- dans le repere du maillage pour le FORM
  20428. * ---- avec la procedure de changement de base
  20429. DX DY DZ = @CBGMV DEPXP DEPYP DEPZP TAB1 ;
  20430.  
  20431. DEPX1 = NOMC UX DX NATURE DIFFUS ;
  20432. DEPY1 = NOMC UY DY NATURE DIFFUS ;
  20433. DEPZ1 = NOMC UZ DZ NATURE DIFFUS ;
  20434.  
  20435. DEP1 = DEPX1 ET DEPY1 ET DEPZ1 ;
  20436. FORM DEP1 ;
  20437.  
  20438. *---- Calcul analytique des nouvelles coordonnees dans le repere global
  20439. * (deplacements non projetes meme en 2D)
  20440.  
  20441. XG_NEW = XG_OLD + DEPX0 ;
  20442. YG_NEW = YG_OLD + DEPY0 ;
  20443. ZG_NEW = ZG_OLD + DEPZ0 ;
  20444.  
  20445. XG_OLD = XG_NEW ;
  20446. YG_OLD = YG_NEW ;
  20447. ZG_OLD = ZG_NEW ;
  20448.  
  20449. *---- test sur les eventuels noeuds interceptes
  20450. *---- SEULEMENT SI NECESSAIRE (D'APRES DEMANDE UTILISATEUR)
  20451. ptest pt2 = visavis (MAI1TRAV et pvisa) omb0 delim;
  20452. si ((nbno ptest) > 1) ;
  20453. pt1 pt2 = visavis MAI1TRAV omb0 delim;
  20454. MESS 'nombre de noeuds interceptes ='(nbno pt1);
  20455. LMAX1 = LCOURAN1 ;
  20456. *
  20457. *--- SAUVEGARDE DES POINTS OMBRANTS CONDITIONEL CAR PREND DU TEMPS CPU
  20458. SI REPO ;
  20459. SI (EGA (TYPE POMB) MAILLAGE);
  20460. POMB = POMB ET PT2 ;
  20461. SINON ;
  20462. POMB = PT2 ;
  20463. FINSI ;
  20464. FINSI ;
  20465. *
  20466. *---- construction du champ contenant 1 aux noeuds
  20467. *---- interceptes a l'iteration courante
  20468. chelim1 = manu chpo pt1 1 'SCAL' 1. nature discret ;
  20469.  
  20470. *---- construction du champ contenant n aux noeuds
  20471. *---- interceptes n fois
  20472. chelim = chelim et chelim1 ;
  20473.  
  20474. *---- CHPOINT CONTENANT DES 1 POUR LES NOEUDS
  20475. *---- INTERCEPTES AU MOINS UNE FOIS
  20476. masq1 = chelim masq 'SUPERIEUR' 0. ;
  20477.  
  20478. * ---- nombre de points interceptes depuis le debut
  20479. * ---- du calcul :
  20480. PTPRIS = masq1 poin superieur 0.;
  20481.  
  20482. * ---- on quitte la boucle si tous les noeuds ont
  20483. * ---- ete interceptes
  20484. SI ((NBNO PTPRIS) EGA (NBNO MAI1TRAV)) ;
  20485. QUITER BOUCLE1 ;
  20486. FINSI ;
  20487. FINSI ;
  20488. *---- fin du test d'interception
  20489.  
  20490. *--- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  20491. chdisti = PASB0 * (CHP1 - MASQ1) ;
  20492. chdisti = chan attribut chdisti nature discret ;
  20493. chdist = chan attribut chdist nature discret ;
  20494. chdist = chdist et chdisti ;
  20495. mess 'mini maxi dist connection en m' (mini (prog lmax1(mini chdist))) lmax1 ;
  20496.  
  20497. * mess 'mini maxi dist connection en m'
  20498. * (mini chdist) (maxi chdist);
  20499.  
  20500.  
  20501. *--- Traces intermediaires si TAB1.<NTRAC specifie
  20502. SI (EXIS TAB1 <NTRAC) ;
  20503. NSORT = NBPAS0 / TAB1.<NTRAC ;
  20504. SI (NSORT EGA 0) ;
  20505. NSORT = 1 ;
  20506. FINSI ;
  20507. OUT = (I1 - (NSORT*(I1/NSORT)));
  20508. SI ( OUT EGA 0);
  20509. *---- CAS 3D
  20510. SI (DIM0 EGA 3) ;
  20511. SI TVISA ;
  20512. SI ((nbno ptest) > 1) ;
  20513. titre 'pas='i1' on trouve'(nbno (pt1)) 'noeuds verifiant le critere';
  20514. trac (0. 1.E+6 0.) ((PT1 COUL ROUG) ET MAI1TRAV ET MAIL1 et repxyz ET OMB0 );
  20515. trac (1.E+6 0. 0.) ((PT1 COUL ROUG) ET MAI1TRAV ET MAIL1 et repxyz ET OMB0 );
  20516. trac (0. 0. 1.E+6) ((PT1 COUL ROUG) ET MAI1TRAV ET MAIL1 et repxyz ET OMB0 );
  20517. SINON ;
  20518. titre 'pas='i1' pas de noeud verifiant le critere';
  20519. trac (0. 1.E+6 0.) ((MAI1TRAV COUL ROUG) ET MAIL1 et repxyz ET OMB0 );
  20520. trac (1.E+6 0. 0.) ((MAI1TRAV COUL ROUG) ET MAIL1 et repxyz ET OMB0 );
  20521. trac (0. 0. 1.E+6) ((MAI1TRAV COUL ROUG) ET MAIL1 et repxyz ET OMB0 );
  20522. FINSI ;
  20523. SINON ;
  20524. titre 'pas='i1' pas de test effectue';
  20525. trac (0. 1.E+6 0.) ((MAI1TRAV COUL ROUG) ET MAIL1 et repxyz ET OMB0 );
  20526. trac (1.E+6 0. 0.) ((MAI1TRAV COUL ROUG) ET MAIL1 et repxyz ET OMB0 );
  20527. trac (0. 0. 1.E+6) ((MAI1TRAV COUL ROUG) ET MAIL1 et repxyz ET OMB0 );
  20528. FINSI ;
  20529. *---- CAS 2D ==> TRACE DANS LE PLAN
  20530. SINON ;
  20531. SI ((nbno ptest) > 1) ;
  20532. titre 'pas='i1' on trouve'(nbno (pt1)) 'noeuds verifiant le critere';
  20533. trac (MAI1TRAV ET (PT1 COUL ROUG) ET MAIL1 ET OMB0 );
  20534. SINON ;
  20535. titre 'pas='i1' pas de noeud verifiant le critere';
  20536. trac (MAIL1 ET MAI1TRAV ET OMB0 );
  20537. FINSI ;
  20538. FINSI ;
  20539. FINSI;
  20540. FINSI;
  20541. MENAGE ;
  20542. FIN BOUCLE2 ;
  20543. * --------------------- Fin de la boucle 2 ----------------------
  20544.  
  20545. *---- PASSAGE DU SUPPORT MAILLAGE DEFORME
  20546. *---- AU SUPPORT MAILLAGE INITIAL POUR CHDIST
  20547.  
  20548. * CREATION DE LA LISTE DES DISTANCES CONTENUES DANS CHDIST
  20549. *
  20550. NDIST = NBNO MAI1TRAV ;
  20551. I = 1 ;
  20552. MAI1TRAV = CHAN MAI1TRAV POI1 ;
  20553. PT1 = ELEM MAI1TRAV POIN 1 ;
  20554. DIST1 = EXTR CHDIST SCAL PT1 ;
  20555. LDIST = PROG DIST1 ;
  20556. REPETER BOULISTE (NDIST - 1) ;
  20557. I = I + 1 ;
  20558. PTI = ELEM MAI1TRAV POIN I ;
  20559. DISTI = EXTR CHDIST SCAL PTI ;
  20560. LDIST = LDIST ET (PROG DISTI) ;
  20561. FIN BOULISTE ;
  20562.  
  20563. * CONSTRUCTION DU CHAMP DES DISTANCES SUR LE MAILLAGE NON DEFORME *
  20564. CHDIST0 = MANU CHPO MAIL1 1 SCAL LDIST ;
  20565.  
  20566. *--- Sorties dans TAB1
  20567. TAB1.<DELIM = DELIM ;
  20568. TAB1.<CONNEXION_MAX = LMAX1 ;
  20569. TAB1.<LONGUEUR_REMONTEE = LCOURAN1 ;
  20570. MESS '---------------------------------> exiting @TESTGEO';
  20571. FINPROC CHDIST0 MAI1TRAV POMB ;
  20572.  
  20573. **** @THERSC0
  20574. 'DEBPROC' @THERSC0 TAB1*'TABLE ' ;
  20575. MESS ' ' ;
  20576. NIVEAU = TAB1.'NIVEAU' ;
  20577. SI ((EXISTE TAB1 'VITESSE') OU (EXISTE TAB1 'PRESS_IN') OU (EXISTE TAB1 'TEMPE_IN'));
  20578. MESS ' ' ;
  20579. MESS ' ' ;
  20580. MESS ' ' ;
  20581. MESS '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' ;
  20582. MESS ' ' ;
  20583. MESS '>@THERSC0> RM le 26/10/95 ' ;
  20584. MESS '>@THERSC0> attention plusieurs donnees doivent etre stockees';
  20585. MESS '>@THERSC0> sous des noms d indices differents ' ;
  20586. MESS '>@THERSC0> VITESSE remplace par V_IN ' ;
  20587. MESS '>@THERSC0> TEMPE_IN remplace par T_IN ' ;
  20588. MESS '>@THERSC0> PRESS_IN remplace par P_IN ' ;
  20589. MESS ' ' ;
  20590. MESS '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' ;
  20591. MESS ' ' ;
  20592. MESS ' ' ;
  20593. MESS ' ' ;
  20594. MESS ' ' ;
  20595. FINSI;
  20596.  
  20597. SI (NIVEAU >EG 4 ) ;
  20598. MESS '---------------------------------> calling @THERSC0';
  20599. MESS '>@THERSC0> Talking Level' NIVEAU ;
  20600. FINSI ;
  20601. *
  20602. * --- procedure d'initialisation thermique standard groupe CFP
  20603. *
  20604. TAC8 = TABLE ;
  20605. TAC8.1 = 'MARQ CROI REGU' ;
  20606. TAC8.2 = 'MARQ PLUS REGU' ;
  20607. TAC8.3 = 'MARQ ETOI REGU' ;
  20608. TAC8.4 = 'MARQ LOSA REGU' ;
  20609. TAC8.5 = 'MARQ CARR REGU' ;
  20610. TAC8.6 = 'MARQ TRIA REGU' ;
  20611. TAC8.7 = 'MARQ TRIB REGU' ;
  20612. TAC8.8 = 'MARQ PLUS REGU' ;
  20613. TAC8.9 = 'MARQ ETOI REGU' ;
  20614. TAC8.10 = 'MARQ CROI REGU' ;
  20615. TAC8.11 = 'MARQ LOSA REGU' ;
  20616. TAC8.12 = 'MARQ CARR REGU' ;
  20617. TAC8.13 = 'MARQ TRIA REGU' ;
  20618. TAC8.14 = 'MARQ TRIB REGU' ;
  20619. TAC8.15 = 'MARQ ETOI REGU' ;
  20620. TAC8.16 = 'MARQ CROI REGU' ;
  20621. TAC8.17 = 'MARQ PLUS REGU' ;
  20622. TAC8.18 = 'MARQ CARR REGU' ;
  20623. TAC8.19 = 'MARQ CARR REGU' ;
  20624. TAC8.20 = 'MARQ TRIA REGU' ;
  20625. TAC8.21 = 'MARQ TRIB REGU' ;
  20626. TAC8.22 = 'MARQ CROI REGU' ;
  20627. TAC8.23 = 'MARQ PLUS REGU' ;
  20628. TAC8.24 = 'MARQ ETOI REGU' ;
  20629. TAC8.25 = 'MARQ CROI REGU' ;
  20630. TAC8.26 = 'MARQ PLUS REGU' ;
  20631. TAC8.27 = 'MARQ ETOI REGU' ;
  20632. TAC8.28 = 'MARQ CROI REGU' ;
  20633. *
  20634. SI ( EGA ( VALE DIME) 2 ) ;
  20635. TAB1.VIEW_P = TEXT ' ' ;
  20636. FINSI ;
  20637. SI ( NON (EXISTE TAB1 VIEW_P )) ;
  20638. SI ( EGA ( VALE DIME) 3 ) ;
  20639. TAB1.VIEW_P = 1.E8 -1.E8 1.E8 ;
  20640. FINSI ;
  20641. FINSI ;
  20642. *
  20643. * list V_DIM1 ;
  20644. * list TAB1.LFLUX_EXTE;
  20645. V_DIM1 = VALEUR 'DIME' ;
  20646. SI ( V_DIM1 EGA 2) ;
  20647. TFRONT1 = TEXT ' CONTOUR ' ;
  20648. TAB1 . MO_CONTOUR = TEXT ' CONTOUR ' ;
  20649. SI ( NON ( EXISTE TAB1 LFLUX_EXTE_DESS));
  20650. TAB1.LFLUX_EXTE_DESS = TAB1.LFLUX_EXTE ;
  20651. FINSI ;
  20652. SI ( NON ( EXISTE TAB1 LFLUX_CONV_DESS));
  20653. TAB1.LFLUX_CONV_DESS = TAB1.LFLUX_CONV ;
  20654. FINSI ;
  20655. SI ( NON ( EXISTE TAB1 LFLUX_RAYO_DESS));
  20656. TAB1.LFLUX_RAYO_DESS = TAB1.LFLUX_RAYO ;
  20657. FINSI ;
  20658. SINON ;
  20659. TFRONT1 = TEXT ' ENVELOP ' ;
  20660. TAB1 . MO_CONTOUR = TEXT ' ENVELOP ' ;
  20661. FINSI ;
  20662.  
  20663. SI ( NON ( EXISTE TAB1 TITR_MAQ )) ;
  20664. TAB1.TITR_MAQ = ' ' ;
  20665. SI (NIVEAU >EG 2) ;
  20666. MESS '>@THERSC0> TAB1.TITR_MAQ set to default value : nothing ' ;
  20667. FINSI ;
  20668. FINSI ;
  20669.  
  20670. SI ( NON ( EXISTE TAB1 T_TAPE )) ;
  20671. TAB1.T_TAPE = 0. ;
  20672. SI (NIVEAU >EG 2) ;
  20673. MESS '>@THERSC0> TAB1.T_TAPE set to default value : 0 ' ;
  20674. FINSI ;
  20675. FINSI ;
  20676.  
  20677. SI ( NON ( EXISTE TAB1 TWIST_RATIO )) ;
  20678. TAB1.TWIST_RATIO = 0. ;
  20679. SI (NIVEAU >EG 2) ;
  20680. MESS '>@THERSC0> TAB1.TWIST_RATIO set to default value : 0';
  20681. FINSI ;
  20682. FINSI ;
  20683.  
  20684. SI ( NON ( EXISTE TAB1 L_TRAC_FLUXI )) ;
  20685. TAB1.L_TRAC_FLUXI = FAUX ;
  20686. SI (NIVEAU >EG 2) ;
  20687. MESS '>@THERSC0> TAB1.L_TRAC_FLUXI set to default value : FAUX' ;
  20688. FINSI ;
  20689. FINSI ;
  20690.  
  20691. SI (NON (EXISTE TAB1 CHFCORRELATION));
  20692. TAB1.CHFCORRELATION = MOTS 'TONG';
  20693. SI (NIVEAU >EG 2) ;
  20694. MESS '>@THERSC0> TAB1.CHFCORRELATION set to default value : TONG' ;
  20695. FINSI ;
  20696. FINSI ;
  20697.  
  20698. SI (NON (EXISTE TAB1 X_LOCAL));
  20699. TAB1.'X_LOCAL' = 1. ;
  20700. SI (NIVEAU >EG 2) ;
  20701. MESS '>@THERSC0> TAB1.X_LOCAL set to default value : 1.(=exit)' ;
  20702. FINSI ;
  20703. FINSI ;
  20704.  
  20705.  
  20706. *
  20707. *--- CARACT . DE L'ECOULEMENT
  20708. *
  20709. PI = 3.14159 ;
  20710. *
  20711. VIN = TAB1 . V_IN ;
  20712. TAB1.V_LOCAL = VIN ;
  20713. MESS '>@THERSC0> V_LOCAL set to VIN (provisional) ';
  20714. TIN = TAB1 . T_IN ;
  20715. LMAQ = TAB1 . L_MAQUETTE ;
  20716. DIAM1 = TAB1 . D_MAQUETTE ;
  20717. PIN = TAB1 . P_IN ;
  20718. TTAPE = TAB1 . T_TAPE ;
  20719. YTWIST = TAB1 . TWIST_RATIO ;
  20720. LAMBDA = TAB1 . 'LAMBDA' ;
  20721. LPAT1 = TAB1 . LFLUX_EXTE ;
  20722. *
  20723. *--- CALCUL CHUTE DE PRESSION
  20724. *
  20725. *js tous ces XLPAT1 XL_LPAT1 TAB1 . W_HEATED n'ont rien a faire ici
  20726. *js c est le pb CFLUX
  20727. XLPAT1 = COOR 1 LPAT1 ;
  20728. XL_LPAT1 = ABS (( MAXI XLPAT1 ) - ( MINI XLPAT1 ));
  20729.  
  20730. MESS '>@THERSC0> width of the mesh line used for flux deposition' XL_LPAT1 ;
  20731.  
  20732. SI ( NON ( EXISTE TAB1 W_HEATED )) ;
  20733. TAB1 . W_HEATED = XL_LPAT1 * (TAB1 . FSYM_X ) ;
  20734. MESS '>@THERSC0> Heated width (with symetrical part)' (TAB1.W_HEATED);
  20735. SINON ;
  20736. XL_HEATE = ((TAB1 . W_HEATED ) / (TAB1 . FSYM_X )) ;
  20737. MESS '>@THERSC0> control of the heated width ' ;
  20738. MESS '>@THERSC0> heated width / FSYM_X ' XL_HEATE ;
  20739. FINSI ;
  20740.  
  20741. SI (NIVEAU >EG 3 ) ;
  20742. MESS '>@THERSC0> prompting of various data before PDROP';
  20743. MESS DIAM1 VIN TIN LMAQ (TAB1.L_HEATED) (TAB1.W_HEATED) LAMBDA PIN TTAPE YTWIST ;
  20744. FINSI ;
  20745.  
  20746. SI ( NON ( EXISTE TAB1 HYPERVAP ) ) ;
  20747. TAB1.HYPERVAP = FAUX ;
  20748. FINSI ;
  20749. *js TAB1.P_LOCAL doit etre calculer par @PDROP
  20750. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  20751. TAB1 . P_LOCAL = PIN ;
  20752. SINON ;
  20753. SI (NON (EXISTE TAB1 P_LOCAL)) ;
  20754. DPRES PIN_LH POU_H POUT = @PDROP TAB1 ;
  20755. TAB1.P_LOCAL = PIN_LH + ((POU_H - PIN_LH) * TAB1.'X_LOCAL') ;
  20756. FINSI ;
  20757. FINSI ;
  20758. *
  20759. *
  20760. *js CPF = @IPOE TIN TAB1.ETCPF ;
  20761. *js
  20762. *js RHOIN = @IPOE TIN TAB1.ETRHOF ;
  20763. *
  20764. *js NNUIN = @IPOE TIN TAB1.ETNNU ;
  20765. *js GIN = RHOIN * VIN ;
  20766. *js SI ( EXISTE TAB1 RIP_FLOWS ) ;
  20767. *js EMDOTI = GIN * ( TAB1 . RIP_FLOWS ) ;
  20768. *js SINON ;
  20769. *js SI ( EGA TAB1.HYPERVAP VRAI ) ;
  20770. *js TAB1.HYP_SM = ( TAB1.LARG_CANAL * TAB1.HMIN_CANAL ) +
  20771. *js ( 2. * ( TAB1.LARG_ESP * TAB1.HFIN ) ) ;
  20772. *js EMDOTI = GIN * TAB1.HYP_SM ;
  20773. *js SINON ;
  20774. *js EMDOTI = GIN * ( ( PI * DIAM1 * DIAM1 / 4. ) - ( DIAM1 * TTAPE) ) ;
  20775. *js FINSI ;
  20776. *js FINSI ;
  20777. * Parametre servant au calcul de Tout grace au flux,
  20778. * au Cp et a Tin
  20779. *js TAB1.V_EMDOTI = EMDOTI ;
  20780.  
  20781. *
  20782. *--- DONNEES POUR 'H' DANS LA BOUCLE
  20783. *
  20784. SI (NIVEAU >EG 2 ) ;
  20785. MESS '>@THERSC0> >>>>> 1 >>>>>>' ;
  20786. FINSI ;
  20787. SI ( NON ( EXISTE TAB1 TRANSITOIRE )) ;
  20788. TAB1.TRANSITOIRE = FAUX ;
  20789. FINSI ;
  20790. SI ( NON ( EXISTE TAB1 PERMANENT )) ;
  20791. TAB1.PERMANENT = FAUX ;
  20792. FINSI ;
  20793. SI ( NON ( EXISTE TAB1 MAX_SOFL )) ;
  20794. TAB1.MAX_SOFL = 50.E6 ;
  20795. FINSI ;
  20796. SI ( NON ( EXISTE TAB1 OLD )) ;
  20797. TAB1.OLD = VRAI ;
  20798. FINSI ;
  20799. SI TAB1.OLD ;
  20800. EVMA1 EVCA1 TACC1 = @DEMATH1 TAB1 ;
  20801. SINON ;
  20802. EVMA1 EVCA1 TACC1 = @DEMATH2 TAB1 ;
  20803. FINSI ;
  20804. *js3.95 ici il faudrait faire une proc de controle du maillage @CTMAIL
  20805. SI (NIVEAU >EG 2 ) ;
  20806. MESS '>@THERSC0> >>>>> 2.1>>>>>>> ' ;
  20807. FINSI ;
  20808.  
  20809. IPP1 = 0 ;
  20810. REPETER BOUCMA8 ;
  20811. IPP1 = IPP1 + 1 ;
  20812. SI ( EXISTE (TAB1.ZONE_MAT) IPP1 ) ;
  20813. SI ( IPP1 EGA 1 ) ;
  20814. S_TOT1 = TAB1.ZONE_MAT . IPP1 ;
  20815. C_ONT1 = TFRONT1 (TAB1.ZONE_MAT . IPP1 ) ;
  20816. SINON ;
  20817. S_TOT1 = S_TOT1 ET (TAB1.ZONE_MAT . IPP1) ;
  20818. C_ONT1 = C_ONT1 ET ( TFRONT1 (TAB1.ZONE_MAT. IPP1)) ;
  20819. FINSI ;
  20820. SINON ;
  20821. QUITTER BOUCMA8 ;
  20822. FINSI ;
  20823. FIN BOUCMA8 ;
  20824. TAB1.'M_ILLAGE_TOT' = S_TOT1 ;
  20825. TAB1.'<MAILLAGE' = S_TOT1 ;
  20826.  
  20827. TRAC TAB1.VIEW_P S_TOT1 ;
  20828. TAB1.'M_IL_CONTOUR' = C_ONT1 ;
  20829. IPP1 = 0 ;
  20830.  
  20831. SI ( EXISTE TAB1 V_SOURCE ) ;
  20832. MESS '>@THERSC0> There is a volumetric heat source';
  20833. MO_TOT = MODE S_TOT1 'THERMIQUE' 'ISOTROPE' ;
  20834. FSOU1 = SOURCE MO_TOT 0. S_TOT1 ;
  20835. FINSI ;
  20836. REPETER BOUCMA9 ;
  20837. IPP1 = IPP1 + 1 ;
  20838. SI ( EXISTE (TAB1.ZONE_MAT) IPP1 ) ;
  20839. SI ( EXISTE TAB1 V_SOURCE ) ;
  20840. *jfs,le 18/07/95: ajout de la possibilite d'utiliser des sources
  20841. * variables dans les materiaux (chpoints)
  20842. SI ( EXISTE (TAB1.V_SOURCE) CHSO ) ;
  20843. SI ( EXISTE (TAB1.V_SOURCE.CHSO) IPP1 ) ;
  20844. MO_1 = TAB1.DEF_MO.IPP1 ;
  20845. FSOU1 = FSOU1 ET ( SOURCE MO_1 TAB1.V_SOURCE.CHSO.IPP1 ) ;
  20846. MESS '>THERSCH0> SOURCE MATERIAL CHPOINT ' IPP1 ;
  20847. FINSI ;
  20848. SINON ;
  20849. SI ( EXISTE (TAB1.V_SOURCE) IPP1 ) ;
  20850. * MO_1 = MODE TAB1.ZONE_MAT.IPP1 'THERMIQUE' 'ISOTROPE' ;
  20851. MO_1 = TAB1.DEF_MO.IPP1 ;
  20852. FSOU1 = FSOU1 ET ( SOURCE MO_1 TAB1.V_SOURCE.IPP1 TAB1.ZONE_MAT.IPP1 ) ;
  20853. MESS '>@THERSC0> SOURCE MATERIAL ' IPP1 ;
  20854. FINSI ;
  20855. FINSI ;
  20856. FINSI ;
  20857. SINON ;
  20858. QUITTER BOUCMA9 ;
  20859. FINSI ;
  20860. FIN BOUCMA9 ;
  20861. TAB1.'FSOU1' = FSOU1 ;
  20862. *
  20863. SI (NIVEAU >EG 2 ) ;
  20864. MESS '>@THERSC0> >>>>> 2.2 >>>>>>' ;
  20865. FINSI ;
  20866. TRAC TAB1.VIEW_P CACH TAB1.'M_IL_CONTOUR' ;
  20867. SI ( EXISTE TAB1 VIEW_P2 ) ;
  20868. TRAC CACH TAB1.VIEW_P2 C_ONT1 ;
  20869. FINSI ;
  20870. * TEX1 = TEXTE TAB1.NOM_MAT.1 '_MAT_1_CONDUCTIVITY' ;
  20871. SI ( NON ( EXISTE TAB1 V_XBORMA));
  20872. TAB1.V_XBORMA = 1500. ;
  20873. FINSI ;
  20874. TAC1 = TABLE ;
  20875. * TAC1.1 = TEXTE 'MARQ TRIA TITRE ' TEX1 ;
  20876. DESSIN EVMA1 XBOR 0. TAB1.V_XBORMA YBOR 0. 500. MIMA LEGE TACC1;
  20877. SI ( TAB1.TRANSITOIRE ) ;
  20878. TAC1 = TABLE ;
  20879. SI (EXISTE (TAB1.ZONE_MAT) 1);
  20880. TAC1.1 = ET 'MARQ TRIA REGU TITRE ' TAB1.NOM_MAT.1;
  20881. FINSI;
  20882. SI (EXISTE (TAB1.ZONE_MAT) 2);
  20883. TAC1.2 = ET 'MARQ TRIB TITRE ' TAB1.NOM_MAT.2;
  20884. FINSI;
  20885. SI (EXISTE (TAB1.ZONE_MAT) 3);
  20886. TAC1.3 = ET 'MARQ ETOI TITRE 'TAB1.NOM_MAT.3;
  20887. FINSI;
  20888. SI (EXISTE (TAB1.ZONE_MAT) 4);
  20889. TAC1.4 = ET 'MARQ LOSA TITRE 'TAB1.NOM_MAT.4;
  20890. FINSI;
  20891. DESSIN EVCA1 XBOR 0. TAB1.V_XBORMA MIMA LEGE TAC1 ;
  20892. FINSI ;
  20893. *js3.95 ici proc pour calcul des cos directeurs
  20894. *** modele necessaire pour le calcul des cosinus directeurs
  20895. *
  20896. MOP_TOT = MODE S_TOT1 'MECANIQUE' 'ELASTIQUE' ;
  20897. *
  20898. *
  20899. *--- PERPENDICULAIRE A LA LIGNE DE RAYONNEMENT
  20900. *
  20901. SI ( NON ( EXISTE TAB1 LFLUX_RAYO_DESS));
  20902. TAB1.LFLUX_RAYO_DESS = TAB1.LFLUX_RAYO ;
  20903. FINSI ;
  20904. *> SI ( NON ( EXISTE TAB1 LFLUX_RAY2 )) ;
  20905. *> TAB1.LFLUX_RAY2 = TAB1.LFLUX_RAYO ;
  20906. *> TAB1.LFLUX_RAY2_DESS = TAB1.LFLUX_RAYO_DESS ;
  20907. *> FINSI ;
  20908. ** LRAYON1 = TAB1.LFLUX_RAYO ;
  20909.  
  20910. COTETR1 SITETR1 C3TETR1 = @VNORM3D (EXTR TAB1.'MODELR' 'MAIL' ) TAB1.LFLUX_RAYO NIVEAU;
  20911. *
  20912. *--- PERPENDICULAIRE A LA LIGNE DE CONVECTION
  20913. *
  20914. * LINT1 = TAB1.LFLUX_CONV ;
  20915. S_CONV = EXTR TAB1.'MODELV' 'MAIL' ;
  20916. C_CONV = TAB1.MO_CONTOUR S_CONV ;
  20917. N_E1 = NBNO C_CONV ;
  20918. N_E2 = NBNO (C_CONV ET TAB1.LFLUX_CONV) ;
  20919. SI ( N_E1 NEG N_E2 ) ;
  20920. ERRE '@THERSC0 >>>NBNO DIFFERENTS POUR LFLUX_CONV et MODELV ' ;
  20921. FINSI ;
  20922. *SI (EXISTE TAB1 STUB1 ) ;
  20923. * COTETC1 SITETC1 C3TETC1 = @VNORM3D
  20924. * TAB1.STUB1 TAB1.LFLUX_CONV NIVEAU;
  20925. *SINON ;
  20926. COTETC1 SITETC1 C3TETC1 = @VNORM3D S_CONV (TAB1.LFLUX_CONV) NIVEAU;
  20927. *FINSI ;
  20928. MESS '@THERSC0 >>>>> 2.3 >>>>>>' ;
  20929. *
  20930. *--- PERPENDICULAIRE A LA LIGNE DE FLUX INCIDENT
  20931. *
  20932. SI ( EXISTE TAB1 'LAMDAQ2' ) ;
  20933. COTETF1 SITETF1 C3TETF1 = @VNORM3D ( EXTR TAB1.'MODELF' 'MAIL') (TAB1.LFLUX_EXTE ET TAB1.LFLUX_EXT2) NIVEAU;
  20934. SINON;
  20935. COTETF1 SITETF1 C3TETF1 = @VNORM3D (EXTR TAB1.'MODELF' 'MAIL') ( TAB1.LFLUX_EXTE) NIVEAU;
  20936. FINSI ;
  20937. TAB1.C_COTETF1 = COTETF1 ;
  20938. TAB1.C_SITETF1 = SITETF1 ;
  20939. *---- A.MOAL : on a besoin du 3eme cos directeur pour la visu 3D
  20940. TAB1.C_COS3F1 = C3TETF1 ;
  20941. TAB1.C_C3TETF1 = C3TETF1 ;
  20942. *----
  20943. TAB1.C_COTETR1 = COTETR1 ;
  20944. TAB1.C_SITETR1 = SITETR1 ;
  20945. TAB1.C_C3TETR1 = C3TETR1 ;
  20946. TAB1.C_COTETC1 = COTETC1 ;
  20947. TAB1.C_SITETC1 = SITETC1 ;
  20948. TAB1.C_C3TETC1 = C3TETC1 ;
  20949.  
  20950.  
  20951. **>> TETF1 = ATG SITETF1 ( COTETF1 + 1.E-12) ;
  20952. *mess 'cotetft et sitetf1 ' ; list COTETF1 ; list SITETF1;
  20953.  
  20954. *js 3 11 94
  20955. *TAB1.LIS_TEMP = TABLE ;
  20956. * IPP1 = 0;
  20957. * REPETER BOUPO2 (DIME TAB1.LI_POINT);
  20958. * IPP1 = IPP1 + 1;
  20959. * TAB1.LIS_TEMP . IPP1 = PROG;
  20960. * FIN BOUPO2;
  20961. *
  20962. * ca ce devrait etre ds le controle du maillage
  20963. NB_1 = NBNO TAB1.'M_IL_CONTOUR' ;
  20964. NB_2 = NBNO ( TAB1.LFLUX_EXTE ET TAB1.'M_IL_CONTOUR' ) ;
  20965. SI ( NB_1 NEG NB_2 ) ;
  20966. MESS ' IL Y A UN PB ENTRE LA LIGNE DE FLUXI ET LE CONTOUR' ;
  20967. TRACER 'CACH' TAB1.VIEW_P ( TAB1.LFLUX_EXTE ET C_ONT1 ) ;
  20968. ERRE ' REVOIR VOTRE LFLUX_EXTE ' ;
  20969. FINSI ;
  20970. *
  20971. TAB1.CHPOTHETA = TABLE ;
  20972. TAB1.CHPOHCONV = TABLE ;
  20973. SI (NIVEAU >EG 2 ) ;
  20974. MESS '---------------------------------> exiting @THERSC0';
  20975. FINSI ;
  20976.  
  20977. FINPROC ;
  20978.  
  20979. *--------------------------------------------------------------------
  20980. *
  20981. *----------Fin de la procedure @THERSC0
  20982. **** @THERSC1
  20983. 'DEBPROC' @THERSC1 TAB1*'TABLE ' ;
  20984.  
  20985. SI (NON (EXISTE TAB1 NIVEAU));
  20986. TAB1.'NIVEAU' = 1 ;
  20987. FINSI ;
  20988. SI (TAB1.'NIVEAU' >EG 4) ;
  20989. MESS '---------------------------------> calling @THERSC1';
  20990. FINSI ;
  20991.  
  20992. *
  20993. *--- PARAMETRES
  20994. *
  20995. @TABEAU TAB1 ;
  20996. @THERSC0 TAB1 ;
  20997. @FLUXX TAB1 ;
  20998. MENAGE ;
  20999. @TPERM TAB1 ;
  21000. @TTRANS TAB1 ;
  21001. *TAB1.I_FPAT1 = FPAT1;
  21002. TAB1.T_TAC8 = TABLE TAC8;
  21003. SI (TAB1.PERMANENT EGA VRAI);
  21004. FINSI;
  21005.  
  21006. SI (TAB1.'NIVEAU' >EG 4 );
  21007. MESS '---------------------------------> exiting @THERSC1';
  21008. FINSI ;
  21009.  
  21010. FINPROC;
  21011. *--------------------------------------------------------------------
  21012. *
  21013. *----------Fin de la procedure @THERSC1
  21014. *
  21015. **** @TOKAFLU
  21016. DEBPROC @TOKAFLU TAB1*TABLE ;
  21017. *
  21018. *123456789012345678901234567890123456789012345678901234567890123456789012
  21019. **************************************************************
  21020. * Procedure de calcul du profil du depot de puissance sur un *
  21021. * objet en tenant compte du ripple et du shift de Shafranov. *
  21022. * Alain MOAL (aout 1995-janvier 1996) *
  21023. **************************************************************
  21024. *
  21025. MESS '---------------------------------> calling @TOKAFLU';
  21026. *
  21027. *---- Valeurs par defaut, verification des indices de la table
  21028. @VDEFAUT TAB1 ;
  21029. *
  21030. *--------------- VARIABLES D'ENTREE :
  21031. MAIL0 = TAB1.<MAILLAGE ;
  21032. CONT0 = TAB1.LFLUX_EXTE ;
  21033. LAMBQREF = TAB1.<LAMBQREF ;
  21034. THETA0 = TAB1.<THETA0 ;
  21035. RHO0 = TAB1.<RHO0 ;
  21036. RP = TAB1.<RP ;
  21037. IMESS = TAB1.<IMESS ;
  21038. MMAIL0 = TAB1.MODELF ;
  21039. TYPCAL = TAB1.<TYPE_CALCUL ;
  21040. TYPDEP = MOT TAB1.<TYPE_DEPOT ;
  21041. ITRAC = TAB1.<ITRAC ;
  21042. SI (NON (EXISTE TAB1 <NXM)) ;
  21043. ICALNORM = VRAI ;
  21044. SINON ;
  21045. ICALNORM = FAUX ;
  21046. NXM = TAB1.<NXM ;
  21047. NYM = TAB1.<NYM ;
  21048. NZM = TAB1.<NZM ;
  21049. FINSI ;
  21050. SI ((VALEUR DIME) EGA 3) ;
  21051. OEIL0 = TAB1.VIEW_P ;
  21052. SINON ;
  21053. CONTDES0 = TAB1.LFLUX_EXTE_DESS ;
  21054. FINSI ;
  21055. *------------------------------------
  21056. *
  21057. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  21058. ISHIFT = VRAI ;
  21059. IRIPPLE = VRAI ;
  21060. FINSI ;
  21061. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  21062. ISHIFT = VRAI ;
  21063. IRIPPLE = FAUX ;
  21064. FINSI ;
  21065. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  21066. ISHIFT = FAUX ;
  21067. IRIPPLE = VRAI ;
  21068. FINSI ;
  21069. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  21070. ISHIFT = FAUX ;
  21071. IRIPPLE = FAUX ;
  21072. FINSI ;
  21073. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  21074. ERRE ' >>>> @TOKAFLU : check the value of TAB1.<TYPE_CALCUL';
  21075. FINSI ;
  21076. SI (EGA TYPDEP 'PARALLELE');
  21077. ITYPDEP = VRAI ;
  21078. SINON ;
  21079. ITYPDEP = FAUX ;
  21080. FINSI ;
  21081. *
  21082. *---- coordonnees dans le repere du maillage
  21083. XM = COOR 1 CONT0 ;
  21084. YM = COOR 2 CONT0 ;
  21085. SI ((VALEUR DIME) EGA 2) ;
  21086. ZM = XM * 0. ;
  21087. SINON ;
  21088. ZM = COOR 3 CONT0 ;
  21089. FINSI ;
  21090. *
  21091. *---- coordonnees dans le repere global
  21092. XG YG ZG = @CRMGC XM YM ZM TAB1 ;
  21093. MENAGE ;
  21094. *
  21095. *---- calcul du champ magnetique dans le repere global
  21096. BXG BYG BZG FSECU = @CHAMB TAB1 XG YG ZG ISHIFT IRIPPLE ;
  21097. MENAGE ;
  21098. *
  21099. *---- composantes de B dans le repere du maillage
  21100. BXM BYM BZM = @CBGMV BXG BYG BZG TAB1 ;
  21101. MENAGE ;
  21102. *
  21103. *---- calcul des normales a la surface calculees
  21104. *---- dans le repere du maillage
  21105. SI (ICALNORM) ;
  21106. NXM NYM NZM = @VNORM3D MAIL0 CONT0 ;
  21107. TAB1.<NXM = NXM ;
  21108. TAB1.<NYM = NYM ;
  21109. TAB1.<NZM = NZM ;
  21110. FINSI;
  21111. MENAGE ;
  21112. *
  21113. *---- calcul du produit scalaire et de l'angle d'incidence
  21114. B_NORM = ((BXM*BXM) + (BYM*BYM) + (BZM*BZM))**0.5 ;
  21115. VBVN = (ABS ((BXM*NXM) + (BYM*NYM) + (BZM*NZM))) / B_NORM;
  21116. ANGINCI = ATG ((1.-(VBVN**2))**0.5) VBVN ;
  21117. *
  21118. *---- dans le plan xy du repere du maillage
  21119. BETA2DXY = ATG (BYM*-1.) (BXM*-1.) ;
  21120. *---- dans le plan xz du repere du maillage
  21121. BETA2DXZ = ATG (BZM*-1.) (BXM*-1.) ;
  21122. *
  21123. *---- calcul de Lambdaq et des facteurs de compression
  21124. LAMBQ HS HR DELTA = @CLAMQ TAB1 XG YG ZG ISHIFT IRIPPLE ;
  21125. MENAGE ;
  21126. *
  21127. *---- calcul de la densite de puissance recue par chaque point
  21128. VAR1 = EXP (DELTA * -1. / LAMBQ) ;
  21129. *
  21130. *---- profil du flux modif RM le 08/12/1998
  21131. SI ITYPDEP ;
  21132. PROFIL0 = VAR1 * VBVN ;
  21133. SINON ;
  21134. PROFIL0 = VAR1 * ((1. - (VBVN*VBVN)) ** .5) ;
  21135. FINSI ;
  21136. *
  21137. *---- integration du profil de flux sur la surface
  21138. PROCONT0 = NOMC SCAL (FLUX MMAIL0 PROFIL0) ;
  21139. *
  21140. *---- calcul du profil moyen
  21141. PROMOY = (MAXI (RESU PROCONT0)) / (MESU CONT0) ;
  21142. *
  21143. SI (IMESS >EG 2) ;
  21144. MESS '>>>> @TOKAFLU : BXM '; MESS (MAXI BXM) (MINI BXM) ;
  21145. MESS '>>>> @TOKAFLU : BYM '; MESS (MAXI BYM) (MINI BYM) ;
  21146. MESS '>>>> @TOKAFLU : BZM '; MESS (MAXI BZM) (MINI BZM) ;
  21147. MESS '>>>> @TOKAFLU : PROFIL0 ';
  21148. MESS (MAXI PROFIL0) (MINI PROFIL0) ;
  21149. MESS '>>>> @TOKAFLU : VAR1 '; MESS (MAXI VAR1) (MINI VAR1) ;
  21150. MESS '>>>> @TOKAFLU : ANGINCI ';
  21151. MESS (MAXI ANGINCI) (MINI ANGINCI) ;
  21152. FINSI ;
  21153. SI (IMESS >EG 3) ;
  21154. MESS '>>>> @TOKAFLU : BXM '; LIST BXM ;
  21155. MESS '>>>> @TOKAFLU : BYM '; LIST BYM ;
  21156. MESS '>>>> @TOKAFLU : BZM '; LIST BZM ;
  21157. MESS '>>>> @TOKAFLU : VBVN '; LIST VBVN ;
  21158. MESS '>>>> @TOKAFLU : BETA2DXY '; LIST BETA2DXY ;
  21159. MESS '>>>> @TOKAFLU : BETA2DXZ '; LIST BETA2DXZ ;
  21160. MESS '>>>> @TOKAFLU : ANGINCI '; LIST ANGINCI ;
  21161. MESS '>>>> @TOKAFLU : PROFIL0 '; LIST PROFIL0 ;
  21162. FINSI ;
  21163. *
  21164. *---- visualisations des resultats en 2D et en 3D
  21165. *
  21166. MENAGE ;
  21167. *---- vecteur champ magnetique et vecteur normal dans le repere
  21168. *---- du maillage en vue de la visualisation
  21169. VB1 = @CVECT BXM BYM BZM CONT0 VERT;
  21170. VN1 = @CVECT NXM NYM NZM CONT0 BLEU;
  21171. *
  21172. *---- profil de flux visualise dans la direction de la normale rentrante
  21173. DNORMX = PROFIL0 * NXM * -1. ;
  21174. DNORMY = PROFIL0 * NYM * -1. ;
  21175. DNORMZ = PROFIL0 * NZM * -1. ;
  21176. VECT1 = @CVECT DNORMX DNORMY DNORMZ CONT0 JAUN ;
  21177. *
  21178. *---- profil de flux integre visualise dans la direction de la normale
  21179. rentrante FNORMX = PROCONT0 * NXM * -1. ;
  21180. FNORMY = PROCONT0 * NYM * -1. ;
  21181. FNORMZ = PROCONT0 * NZM * -1. ;
  21182. VECT2 = @CVECT FNORMX FNORMY FNORMZ CONT0 JAUN ;
  21183. *
  21184. *---- traces en 2D
  21185. SI (((VALEUR DIME) EGA 2) ET ITRAC) ;
  21186. CONT0 = CONT0 COUL ROUG ;
  21187. TITRE '@TOKAFLU : NORMAL AND MAGNETIC VECTOR' ;
  21188. TRACE (VN1 ET VB1) CONT0 ;
  21189. * TRACE VB1 CONT0 ;
  21190. *
  21191. * ---- trace de courbes
  21192. TITRE '@TOKAFLU : DISTANCE TO THE LCFS (m)';
  21193. DELTA1 = NOMC SCAL DELTA ;
  21194. TAB1.1 = 'TIRR';
  21195. DESSIN (EVOL JAUN CHPO DELTA1 SCAL CONTDES0) MIMA TAB1 ;
  21196. *
  21197. TITRE '@TOKAFLU : SAFETY FACTOR Q = (a.Btor/R.Bpol)';
  21198. FSECU1 = NOMC SCAL FSECU ;
  21199. DESSIN (EVOL JAUN CHPO FSECU1 SCAL CONTDES0) MIMA ;
  21200. *
  21201. TITRE '@TOKAFLU : COSINUS OF THE ANGLE BETWEEN b AND n' ;
  21202. VBVN1 = NOMC SCAL VBVN ;
  21203. DESSIN (EVOL JAUN CHPO VBVN1 SCAL CONTDES0) MIMA ;
  21204. *
  21205. TITRE '@TOKAFLU : angle = arctg (Bz/Bx)' ;
  21206. ANGLE0 = ATG (ABS BZG) (ABS BXG) ;
  21207. ANGLE1 = NOMC SCAL ANGLE0 ;
  21208. DESSIN (EVOL JAUN CHPO ANGLE1 SCAL CONTDES0) MIMA ;
  21209. *
  21210. * TITRE 'BETA2D : ANGLE BETWEEN B AND X AXIS (assuming Bz = 0)';
  21211. * BETA2D1 = NOMC SCAL BETA2DXY ;
  21212. * DESSIN (EVOL JAUN CHPO BETA2D1 SCAL CONTDES0) MIMA ;
  21213. * TITRE 'BETA2D : ANGLE BETWEEN B AND X AXIS (assuming By = 0)';
  21214. * BETA2D2 = NOMC SCAL BETA2DXZ ;
  21215. * DESSIN (EVOL JAUN CHPO BETA2D2 SCAL CONTDES0) MIMA ;
  21216. *
  21217. TITRE '@TOKAFLU : COMPRESSION FACTORS HS (shift) AND HR (ripple)';
  21218. TAB1.1 = 'TIRR';
  21219. HS1 = NOMC SCAL HS ;
  21220. HR1 = NOMC SCAL HR ;
  21221. DESSIN ((EVOL ROUG CHPO HR1 SCAL CONTDES0) ET (EVOL JAUN CHPO HS1 SCAL CONTDES0)) MIMA TAB1;
  21222. *
  21223. TITRE '@TOKAFLU : LAMBDAQ (m)' ;
  21224. LAMBQ1 = NOMC SCAL LAMBQ ;
  21225. DESSIN (EVOL JAUN CHPO LAMBQ1 SCAL CONTDES0) MIMA;
  21226. *
  21227. TITRE '@TOKAFLU : EXP (-DELTA / LAMDAQ) ';
  21228. VAR11 = NOMC SCAL VAR1 ;
  21229. *AM DESSIN (EVOL JAUN CHPO VAR11 SCAL CONTDES0) MIMA ;
  21230. *
  21231. TITRE '@TOKAFLU : PROFILE OF THE INCIDENT FLUX' ;
  21232. PROFIL1 = NOMC SCAL PROFIL0 ;
  21233. DESSIN (EVOL JAUN CHPO PROFIL1 SCAL CONTDES0) MIMA ;
  21234. *
  21235. TITRE '@TOKAFLU : PROFILE OF THE INCIDENT FLUX' ;
  21236. TRACE VECT1 CONT0 ;
  21237. TITRE '@TOKAFLU : PROFILE OF THE INTEGRATED INCIDENT FLUX' ;
  21238. TRACE VECT2 CONT0 ;
  21239. FINSI ;
  21240. *
  21241. *---- traces en 3D
  21242. SI (((VALEUR DIME) EGA 3) ET ITRAC) ;
  21243. *
  21244. SI (EGA (VALEUR ELEM) 'CUB8') ;
  21245. ARET1 = ARETE CONT0 ;
  21246. SINON ;
  21247. ARET1 = ARETE CONT0 40. ;
  21248. FINSI ;
  21249. TITRE '@TOKAFLU : MAGNETIC FIELD AND NORMAL VECTOR' ;
  21250. TRACE CACH OEIL0 (VB1 ET VN1) MAIL0 ;
  21251. TITRE '@TOKAFLU : COSINUS OF THE ANGLE BETWEEN b AND n' ;
  21252. TRACE CACH OEIL0 7 VBVN CONT0 ARET1;
  21253. * RM 11/06/1997 je commente les deux lignes suivantes,
  21254. * car je prefere lui faire tracer 90. - angleinci
  21255. * TITRE '@TOKAFLU : ANGLE BETWEEN VECTORS b AND n (DEGREE)' ;
  21256. * TRACE CACH OEIL0 7 ANGINCI CONT0 ARET1;
  21257. TITRE '@TOKAFLU : ANGLE BETWEEN VECTORS B AND SURFACE (DEGREE)' ;
  21258. TRACE CACH OEIL0 7 (90. - ANGINCI) CONT0 ARET1;
  21259. * TITRE '@TOKAFLU : BETA2DXZ' ;
  21260. * TRACE CACH OEIL0 7 BETA2DXZ CONT0 ARET1;
  21261. * TITRE '@TOKAFLU : BETA2DXY' ;
  21262. * TRACE CACH OEIL0 7 BETA2DXY CONT0 ARET1 ;
  21263. TITRE '@TOKAFLU : NORM OF THE MAGNETIC FIELD (TESLA)' ;
  21264. TRACE CACH OEIL0 7 B_NORM CONT0 ARET1 ;
  21265. TITRE '@TOKAFLU : SAFETY FACTOR Q = (a.Btor/R.Bpol)' ;
  21266. TRACE CACH OEIL0 7 FSECU CONT0 ARET1 ;
  21267.  
  21268. SI (NON (EGA (MAXI LAMBQ) (MINI LAMBQ))) ;
  21269. TITRE '@TOKAFLU : ISOVALUES OF LAMBDAQ (M)' ;
  21270. TRACE CACH OEIL0 7 LAMBQ CONT0 ARET1;
  21271. SINON ;
  21272. MESS '>>> @TOKAFLU >>> Lambdaq constant egal a ' (MAXI LAMBQ) ;
  21273. FINSI ;
  21274.  
  21275. TITRE '@TOKAFLU : DISTANCE TO THE LCFS (M)' ;
  21276. TRACE CACH OEIL0 7 DELTA CONT0 ARET1;
  21277.  
  21278. distmin1 = mini DELTA ;
  21279. mess '>@TOKAFLU> MINIMAL DISTANCE BETWEEN LIMITER AND DSMF' distmin1 ;
  21280.  
  21281. TITRE '@TOKAFLU : exp (- delta / lamdaq)' ;
  21282. TRACE CACH OEIL0 7 VAR1 CONT0 ARET1;
  21283. TITRE '@TOKAFLU : PROFILE OF THE INCIDENT HEAT FLUX' ;
  21284. * TRACE OEIL0 VECT1 CONT0 ;
  21285. TRACE CACH OEIL0 7 PROFIL0 CONT0 ARET1 ;
  21286. * TITRE '@TOKAFLU : PROFILE OF THE INTEGRATED INCIDENT FLUX';
  21287. * TRACE OEIL0 VECT2 CONT0 ;
  21288. FINSI ;
  21289. *
  21290. *--------------- VARIABLES DE SORTIE :
  21291. TAB1.V_FACFM2 = PROMOY ;
  21292. TAB1.<ANGINCI = ANGINCI ;
  21293. TAB1.<VBVN = VBVN ;
  21294. TAB1.<LONG_DECROIS = LAMBQ ;
  21295. TAB1.<DIST_DSMF = DELTA ;
  21296. TAB1.<FSECU = FSECU ;
  21297. *-------------------------------------
  21298. MESS '---------------------------------> exiting @TOKAFLU';
  21299. FINPROC PROFIL0 ;
  21300. **** @TOKAPEN
  21301. DEBPROC @TOKAPEN TAB1*TABLE ;
  21302. *
  21303. *******************************************************************
  21304. * Procedure de prise en compte sommaire de la penetration. *
  21305. * Pour cela, on calcule un profil de flux supplementaire que l'on *
  21306. * ajoutera au profil calcule par @TOKAFLU sur une surface donnee. *
  21307. * Alain MOAL (decembre 1995) *
  21308. *******************************************************************
  21309. *
  21310. MESS '---------------------------------> calling @TOKAPEN';
  21311. *
  21312. *--------------- VARIABLES D'ENTREE :
  21313. SURF0 = TAB1.LFLUX_EXTE ;
  21314. SURF1 = TAB1.<LFLUX_PENE ;
  21315. DELTA = TAB1.<DIST_DSMF ;
  21316. LAMBQ = TAB1.<LONG_DECROIS ;
  21317. VBVN = TAB1.<VBVN ;
  21318. COEF0 = TAB1.<COEFCONS ;
  21319. SI ((VALEUR DIME) EGA 3) ;
  21320. OEIL0 = TAB1.VIEW_P ;
  21321. FINSI ;
  21322. *------------------------------------
  21323. *
  21324. *---- Creation d'un masque sur SURF0
  21325. MASQ1 = DELTA * 0. ;
  21326. *---- Creation d'un masque sur SURF1
  21327. X0 = COOR 1 SURF1 ;
  21328. MASQ2 = X0 * 0. + 1. ;
  21329. *
  21330. MASQ0 = MASQ1 + MASQ2 ;
  21331. PROFIL0 = (EXP (-1.*DELTA/LAMBQ)) * VBVN * COEF0;
  21332. PROFPEN0 = MASQ0 * (EXP (-1.*DELTA/LAMBQ)) * VBVN * COEF0;
  21333. PROFTOT0 = PROFIL0 + PROFPEN0 ;
  21334. SI (EGA (VALEUR DIME) 3) ;
  21335. ARET1 = ARETE SURF0 ;
  21336. TITRE '@TOKAPEN : PROFILE OF THE INCIDENT HEAT FLUX';
  21337. TRACE CACH OEIL0 7 PROFTOT0 SURF0 ARET1 ;
  21338. FINSI ;
  21339. MESS '---------------------------------> exiting @TOKAPEN';
  21340. FINPROC PROFPEN0 ;
  21341. debproc @tokpltg geo1*maillage tab1*table delt_phi*flottant delt_the*flottant;
  21342.  
  21343. * R. Mitteau 23.06.1997
  21344. * cette procédure calcule le plan tangent aux surfaces magnetiques
  21345. * avec shift et avec ripple
  21346. * elle utilise les notations de tokaflu
  21347. *
  21348. * geo1 est suppose defini dans le repere du ripple
  21349. * elle ne marche qu'en 3 D
  21350. * *******************************************************
  21351. *
  21352. * --- recuperatiion données
  21353. *
  21354. COEFA = TAB1.<COEFA ;
  21355. COEFB = TAB1.<COEFB ;
  21356. COEFC = TAB1.<COEFC ;
  21357. ANGPHI0 = TAB1.<ANGPHI0 ;
  21358. NBOB = TAB1.<NBOB ;
  21359. EPS = TAB1.<EPS ;
  21360. NBOB = TAB1.<NBOB ;
  21361. rho0 = TAB1.<RHO0 ;
  21362. g_lamb1 = TAB1.<LAMB ;
  21363. RP1 = TAB1.<RP ;
  21364. *
  21365. * --- calcul des coordonnees de geo1 dans le repere du ripple
  21366. *
  21367. xg yg zg = @crmgc (coor 1 geo1) (coor 2 geo1) (coor 3 geo1) tab1 ;
  21368. rho_ar theta_ar phi_ar = @crgtc xg yg zg 2.2 0.;
  21369. *
  21370. * --- calcul du rhomer, ligne de code pique a @chamb
  21371. *
  21372.  
  21373. RHO_OLD = RHO_aR ;
  21374. KAUX = (EXP(THETA_aR**2 * -1. * COEFC)) * ((COS((PHI_aR + ANGPHI0) * NBOB)) * -1. + 1.) * COEFA ;
  21375. I = 0 ;
  21376. IMAX = 50 ;
  21377. REPETER BOUCLE IMAX ;
  21378. I = I + 1;
  21379. RHO_NEW = RHO_aR + (KAUX * (EXP(RHO_OLD * COEFB))) ;
  21380. SI ((MAXI (ABS((RHO_NEW - RHO_OLD) / RHO_NEW))) &lt;EG EPS) ;
  21381. QUITTER BOUCLE ;
  21382. FINSI ;
  21383. RHO_OLD = RHO_NEW ;
  21384. FIN BOUCLE ;
  21385. SI (I >EG IMAX) ;
  21386. MESS '>>> @CHAMB : NO CONVERGENCE OF THE ITERATIVE METHOD !';
  21387. ERRE ' >>> STOP IN @CHAMB';
  21388. FINSI ;
  21389. RHOMER = RHO_NEW ;
  21390. *
  21391. * --- calcul du premier vecteur tangent a la surface magnetique par
  21392. * variation de phi - l'effet dont il faut
  21393. * tenir compte est le ripple du champ magnetique
  21394. *
  21395. * - _app signifie a plus phi, point cote plus dans le sens toroidal
  21396. *
  21397. the_app = theta_ar ;
  21398. phi_app = phi_ar + delt_phi ;
  21399. rho_app = RHOMER + (COEFA * (exp((COEFB * RHOMER)-(coefc * the_app * the_app))) * ((cos (nbob * phi_app)) - 1.));
  21400.  
  21401. * - _app signifie a moins phi, point cote moins dans le sens toroidal
  21402.  
  21403. the_amp = theta_ar ;
  21404. phi_amp = phi_ar - delt_phi ;
  21405. rho_amp = RHOMER + (COEFA * (exp((COEFB * RHOMER)- (coefc * the_amp * the_amp))) * ((cos (nbob * phi_amp)) - 1.));
  21406.  
  21407.  
  21408. * on repasse dans la base globale
  21409.  
  21410. ppx1 ppy1 ppz1 = @crtgc rho_app the_app phi_app 2.2 0. ;
  21411. pmx1 pmy1 pmz1 = @crtgc rho_amp the_amp phi_amp 2.2 0. ;
  21412.  
  21413. * par difference, on calcule les coordonnee du premier vecteur tangent
  21414.  
  21415. v1gx = ppx1 - pmx1;
  21416. v1gy = ppy1 - pmy1 ;
  21417. v1gz = ppz1 - pmz1 ; ;
  21418.  
  21419. * on repasse dans la base du maillage
  21420.  
  21421. v9mx v9my v9mz = @cbgmv v1gx v1gy v1gz tab1 ;
  21422.  
  21423. * on le normalise
  21424.  
  21425. norm1 =(( v9mx*v9mx)+(v9my*v9my)+(v9mz*v9mz)) ** .5 ;
  21426. v1mx = v9mx / norm1 ;
  21427. v1my = v9my / norm1 ;
  21428. v1mz = v9mz / norm1 ;
  21429.  
  21430.  
  21431. *
  21432. * --- calcul du deuxieme vecteur tangent a la surface magnetique par
  21433. * variation de theta - l'effet principal dont il faut
  21434. * tenir compte est le shift de Shafranov
  21435. *
  21436.  
  21437. * calcul du petit rayon "sous les bobines" de la surface magnetique
  21438. * passant par A
  21439.  
  21440. rho_abob = RHOMER + (COEFA * (exp((COEFB * RHOMER)-(coefc * the_app * the_app))) * ( -2.));
  21441.  
  21442. * calcul du decentrement de ces surfaces par la formule de Safranov
  21443.  
  21444. terme1 = log (rho_abob / rho0 ) ;
  21445. facteu1 = g_lamb1 + .5 ;
  21446. facteu2 = 1. - ((rho_abob/ rho0) ** -2) ;
  21447. terme2 = terme1 + (facteu1 * facteu2) ;
  21448. * delt1 est le decentrement
  21449. delt1 = (rho_abob ** 2) * terme2 / (2. * RP1) ;
  21450. rp2 = RP1 - delt1 ;
  21451.  
  21452. * calcul du petit rayon de la surface magnetique de A
  21453. * (relation dans le triangle)
  21454.  
  21455. pr2 = ((rho_abob * rho_abob) + ((rp2 - 2.2) * (rp2 - 2.2)) - (2. * rho_ar * (rp2 - 2.2) *( cos (theta_ar)))) ** .5 ;
  21456.  
  21457. * calcul de l'angle theta des points de geo1 dans le repere
  21458. * pseudotoroidal de grand rayon le centre de la surface magnetique
  21459.  
  21460. coth2 = ((pr2 * pr2) + ((rp2 - 2.2) * (rp2 - 2.2)) - (rho_abob * rho_abob)) / (-2. * pr2 * (rp2 - 2.2));
  21461.  
  21462. sith2 = (1. - (coth2 * coth2)) ** .5 ;
  21463.  
  21464. theta_ap = atg sith2 coth2 ;
  21465.  
  21466. * les masques servent a bien avoir un theta entre -180 et +180,
  21467. * parce que le sinus calcule par la formule 1 - cos carre
  21468. * est forcement positif, ce qui me donne un theta compris entre
  21469. * 0 et 180.
  21470.  
  21471. masq_p = masq theta_ar egsupe 0. ;
  21472. masq_m = masq theta_ar inferieur 0. ;
  21473.  
  21474. theta_as = (masq_p * theta_ap) - ( theta_ap * masq_m );
  21475.  
  21476. * _apt signifie a plus theta
  21477. * _amt signifie a moins theta
  21478.  
  21479. the_apt = theta_as + delt_the ;
  21480. the_amt = theta_as - delt_the ;
  21481.  
  21482. * on repasse dans le repere du ripple !
  21483.  
  21484. * calcul des petits rayon des points dans le repere du ripple
  21485. * (toujours la formule du triangle, faire le dessin pour
  21486. * comprendre le cos (180. - the_apt) que je n'ai pas remplace par
  21487. * - cos the_apt pour la lisibilite de la procedure.
  21488.  
  21489. pr3_apt = ((pr2 * pr2) + ((rp2 - 2.2) * (rp2 - 2.2)) - (2. * pr2 * (rp2 - 2.2) *( cos (180. - the_apt)))) ** .5 ;
  21490.  
  21491. pr3_amt = ((pr2 * pr2) + ((rp2 - 2.2) * (rp2 - 2.2)) - (2. * pr2 * (rp2 - 2.2) *( cos (180. - the_amt)))) ** .5 ;
  21492.  
  21493. * calcul des theta dans le repere du ripple
  21494.  
  21495. coth2apt = ((pr3_apt * pr3_apt) + ((rp2 - 2.2) * (rp2 - 2.2)) - (pr2 * pr2)) / (2. * pr3_apt * (rp2 - 2.2));
  21496.  
  21497. coth2amt = ((pr3_amt * pr3_amt) + ((rp2 - 2.2) * (rp2 - 2.2)) - (pr2 * pr2)) / (2. * pr3_amt * (rp2 - 2.2));
  21498.  
  21499. sith2apt = (1. - (coth2apt * coth2apt)) ** .5 ;
  21500. sith2amt = (1. - (coth2amt * coth2amt)) ** .5 ;
  21501.  
  21502. thetaapt = atg sith2apt coth2apt ;
  21503. thetaamt = atg sith2amt coth2amt ;
  21504.  
  21505. the_apt = (masq_p * thetaapt) - ( thetaapt * masq_m );
  21506. the_amt = (masq_p * thetaamt) - ( thetaamt * masq_m );
  21507.  
  21508. * par la methode du point fixe, je peux calculer leur rho meridien
  21509. * pr4 est le prefixe pour des valeurs de rho meridien
  21510.  
  21511. RHO_OLD = pr3_apt ;
  21512. KAUX = (EXP(the_apt**2 * -1. * COEFC)) * 2. * COEFA ;
  21513. I = 0 ;
  21514. IMAX = 50 ;
  21515. REPETER BOUCLE IMAX ;
  21516. I = I + 1;
  21517. RHO_NEW = pr3_apt + (KAUX * (EXP(RHO_OLD * COEFB))) ;
  21518. SI ((MAXI (ABS((RHO_NEW - RHO_OLD) / RHO_NEW))) &lt;EG EPS) ;
  21519. QUITTER BOUCLE ;
  21520. FINSI ;
  21521. RHO_OLD = RHO_NEW ;
  21522. FIN BOUCLE ;
  21523. SI (I >EG IMAX) ;
  21524. MESS '>>> @CHAMB : NO CONVERGENCE OF THE ITERATIVE METHOD !';
  21525. ERRE ' >>> STOP IN @CHAMB';
  21526. FINSI ;
  21527. pr4_apt = RHO_NEW ;
  21528.  
  21529. RHO_OLD = pr3_amt ;
  21530. KAUX = (EXP(the_amt**2 * -1. * COEFC)) * 2. * COEFA ;
  21531. I = 0 ;
  21532. IMAX = 50 ;
  21533. REPETER BOUCLE IMAX ;
  21534. I = I + 1;
  21535. RHO_NEW = pr3_amt + (KAUX * (EXP(RHO_OLD * COEFB))) ;
  21536. SI ((MAXI (ABS((RHO_NEW - RHO_OLD) / RHO_NEW))) &lt;EG EPS) ;
  21537. QUITTER BOUCLE ;
  21538. FINSI ;
  21539. RHO_OLD = RHO_NEW ;
  21540. FIN BOUCLE ;
  21541. SI (I >EG IMAX) ;
  21542. MESS '>>> @CHAMB : NO CONVERGENCE OF THE ITERATIVE METHOD !';
  21543. ERRE ' >>> STOP IN @CHAMB';
  21544. FINSI ;
  21545. pr4_amt = RHO_NEW ;
  21546.  
  21547. * il n y a plus qu'a calculer le rho de ces points au bon phi par la
  21548. * formule de ripple
  21549.  
  21550. pr5_apt = COEFA * (exp((COEFB * pr4_apt)-(coefc * the_apt * the_apt))) * ((cos (nbob * phi_ar)) - 1.);
  21551.  
  21552. pr5_amt = COEFA * (exp((COEFB * pr4_amt)-(coefc * the_amt * the_amt))) * ((cos (nbob * phi_ar)) - 1.);
  21553.  
  21554. * on a maintenant les coordonnee des tous les points dans le repere
  21555. * du ripple pr5_apt; the_apt , phi_ar et pr5_amt; the_amt , phi_ar
  21556.  
  21557. * on repasse dans la base globale
  21558.  
  21559. p1gx p1gy p1gz = @cbtgv pr5_apt the_apt phi_ar the_apt phi_ar ;
  21560. p2gx p2gy p2gz = @cbtgv pr5_amt the_amt phi_ar the_amt phi_ar;
  21561.  
  21562. * on calcule par difference les vecteurs dan le repere global
  21563.  
  21564. v2gx = p1gx - p2gx ;
  21565. v2gy = p1gy - p2gy ;
  21566. v2gz = p1gz - p2gz ;
  21567.  
  21568. * on repasse dans la base du maillage
  21569.  
  21570. v9mx v9my v9mz = @cbgmv v2gx v2gy v2gz tab1 ;
  21571.  
  21572. * on le normalise
  21573.  
  21574. norm1 =(( v9mx*v9mx)+(v9my*v9my)+(v9mz*v9mz)) ** .5 ;
  21575. v2mx = v9mx / norm1 ;
  21576. v2my = v9my / norm1 ;
  21577. v2mz = v9mz / norm1 ;
  21578.  
  21579.  
  21580. * --- le produit vectoriel des deux vecteurs tangent a la surface
  21581. * donne la normale aux surfaces magnetiques
  21582. *
  21583. v3mx = (v1my * v2mz) - (v1mz * v2my);
  21584. v3my = (v1mz * v2mx) - (v1mx * v2mz) ;
  21585. v3mz = (v1mx * v2my) - (v1my * v2mx) ;
  21586.  
  21587. *norm1 =(( v3mx*v3mx)+(v3my*v3my)+(v3mz*v3mz)) ** .5 ;
  21588. *list norm1 ;
  21589. finproc v3mx v3my v3mz;
  21590. **** @TONG75
  21591. DEBPROC @TONG75 TAB_1*TABLE ;
  21592. MESS ' ';
  21593. *23456789012345678901234567890123456789012345678901234567890123456789012
  21594. * 1 2 3 4 5 6 7
  21595. ****** PROCEDURE @TONG75 ******
  21596. ********************************************************************
  21597. * CALCUL DU FLUX CRITIQUE SUIVANT LA CORRELATION DE TONG 75
  21598. *-------------------------------------------------------------------
  21599. *
  21600. *
  21601. *
  21602. TIN = TAB_1.'T_IN' ;
  21603. VIN = TAB_1.'V_LOCAL' ;
  21604. TLOCAL = TAB_1.'T_LOCAL' ;
  21605. POUT = TAB_1.'P_LOCAL' ;
  21606. D1 = TAB_1.'D_MAQUETTE' ;
  21607. EL = TAB_1.'L_HEATED' ;
  21608. XL1 = TAB_1.'WE_HEATED' ;
  21609. NIVEAU = TAB_1.'NIVEAU' ;
  21610. HLOCAL = TAB_1.'HLOCAL' ;
  21611. *
  21612. SI (NIVEAU >EG 4) ;
  21613. MESS '-----------------------------------> calling @TONG75';
  21614. FINSI ;
  21615.  
  21616. SI ( NON ( EXISTE TAB_1 TWIST_RATIO ) ) ;
  21617. TAB_1 . TWIST_RATIO = 0. ;
  21618. MESS '>@TONG75> TAB1.TWIST_RATIO set to default value : 0' ;
  21619. FINSI ;
  21620. YTWIST = TAB_1 . TWIST_RATIO ;
  21621.  
  21622. SI ( NON ( EXISTE TAB_1 T_TAPE ) ) ;
  21623. TAB_1 . T_TAPE = 0. ;
  21624. MESS '>@TONG75> TAB1.T_TAPE set to default value : 0' ;
  21625. FINSI ;
  21626. TTAPE = TAB_1 . T_TAPE ;
  21627.  
  21628. SI ( NON ( EXISTE TAB_1 I_CORR_SANDIA ) ) ;
  21629. TAB_1 . I_CORR_SANDIA = 0. ;
  21630. MESS '>@TONG75> TAB1.I_CORR_SANDIA set to default value : 0' ;
  21631. FINSI ;
  21632. ICORSA = TAB_1 . I_CORR_SANDIA ;
  21633.  
  21634. SI( NON ( EXISTE TAB1 I_RANGE )) ;
  21635. TAB1 . I_RANGE = 1 ;
  21636. FINSI ;
  21637. IVALI = TAB_1 . I_RANGE ;
  21638.  
  21639. SI( NON ( EXISTE TAB1 I_NIV_TONG75 )) ;
  21640. TAB1 . I_NIV_TONG75 = 1 ;
  21641. FINSI ;
  21642. INIVEAU = TAB_1 . I_NIV_TONG75 ;
  21643.  
  21644. SI ( NON ( EXISTE TAB_1 HELI_WIRE ) ) ;
  21645. TAB_1.HELI_WIRE = FAUX ;
  21646. MESS '>@TONG75> TAB1.HELI_WIRE set to default value : FAUX' ;
  21647. FINSI ;
  21648.  
  21649. SI ( NON ( EXISTE TAB_1 HYPERVAP ) ) ;
  21650. TAB_1.HYPERVAP = FAUX ;
  21651. MESS '>@TONG75> TAB1.HYPERVAP set to default value : FAUX' ;
  21652. FINSI ;
  21653.  
  21654. SI ( NON ( EXISTE TAB_1 FRICT_FAC ) ) ;
  21655. TAB_1.FRICT_FAC = FAUX ;
  21656. MESS '>@TONG75> TAB1.FRICT_FAC set to default value : FAUX' ;
  21657. FINSI ;
  21658. MESS ' ' ;
  21659.  
  21660. SI ( NON ( EXISTE TAB_1 DESACT_RANGE ) ) ;
  21661. DESACT1 = FAUX ;
  21662. MESS '>@TONG75> TAB1.FRICT_FAC set to default value : FAUX' ;
  21663. SINON;
  21664. DESACT1 = VRAI ;
  21665.  
  21666. FINSI ;
  21667. MESS ' ' ;
  21668.  
  21669. SI (NON DESACT1 ) ;
  21670.  
  21671. * Test sur les entrees pour s'assurer que les conditions d'entree
  21672. * ne s'ecartent pas trop du domaine de definition de TONG75
  21673.  
  21674.  
  21675. * - test sur la vitesse de l'eau
  21676. SI ((VIN < 2.) OU (VIN > 20.)) ;
  21677. MESS 'Water inlet velocity out of Tong75 range 2.- 20.' ;
  21678. ERRE '@TONG75 --> Inlet velocity' ;
  21679. FINSI ;
  21680.  
  21681. * - test sur le diametre
  21682. SI ( EGA TAB_1.HYPERVAP FAUX ) ;
  21683. SI ((D1 < 5.E-3) OU (D1 > 20.E-3)) ;
  21684. MESS 'Tube diameter out of Tong75 range 5.E-3 - 20.E-3' ;
  21685. ERRE '@TONG75 --> Tube diameter' ;
  21686. FINSI ;
  21687. FINSI ;
  21688.  
  21689. * - test sur la Pression
  21690. SI ((POUT < 5.E5) OU (POUT > 42.E5)) ;
  21691. MESS 'Water pressure out of Tong75 range 5.E5 - 42.E5' ;
  21692. ERRE '@TONG75 --> Pressure' ;
  21693. FINSI ;
  21694.  
  21695. * - test sur la temperature
  21696. TSAT = @IPOE POUT TAB_1.EPTSAT ;
  21697. DT1 = TSAT - TLOCAL ;
  21698. SI ((DT1 < 0.) OU (DT1 > 250.)) ;
  21699. MESS 'Temperature out of Tong75 range 0. - 250.' ;
  21700. ERRE '@TONG75 --> Temperature' ;
  21701. FINSI ;
  21702.  
  21703. FINSI ;
  21704. SI ( IVALI EGA 1 ) ;
  21705.  
  21706. ISAUT = 0 ;
  21707. SI ( ( POUT < 2.E5 ) OU ( POUT > 190.E5 ) ) ;
  21708. MESS '>@TONG75> PRESSURE REALLY OUT OF TONG75 RANGE POUT = ' POUT;
  21709. MESS '>@TONG75> PRESSURE RANGE 2.E5 - 190.E5 ' ;
  21710. ISAUT = 1 ;
  21711. FINSI ;
  21712. SI ( EGA TAB_1.HYPERVAP FAUX ) ;
  21713. SI ( ( D1 < 2.E-3 ) OU ( D1 > 45.E-3 ) ) ;
  21714. MESS '>@TONG75> DIAMETER REALLY OUT OF TONG75 RANGE DIAM = ' D1 ;
  21715. MESS '>@TONG75> DIAMETER RANGE 2.E-3 - 45.E-3 ' ;
  21716. ISAUT = 1 ;
  21717. FINSI ;
  21718. FINSI ;
  21719. SI ( ( EL < 0.15 ) OU ( EL > 3.7 ) ) ;
  21720. MESS '>@TONG75> LENGTH REALLY OUT OF TONG75 RANGE EL = ' EL ;
  21721. MESS '>@TONG75> LENGTH RANGE 0.15 - 3.7 ' ;
  21722. ISAUT = 1 ;
  21723. FINSI ;
  21724. FINSI ;
  21725.  
  21726. * Fin des tests sur les entrees de @TONG75
  21727.  
  21728. PI = 3.14159 ;
  21729. *
  21730. SI ( ( YTWIST EGA 0. ) ET ( EGA TAB_1.HYPERVAP FAUX ) ) ;
  21731. TAB_1.DHC = D1 ;
  21732. S1 = PI * D1 * D1 / 4. ;
  21733. TAB_1.DH = D1 ;
  21734. FACV = 1. ;
  21735. FACS = 1.25 ;
  21736. TAB_1.M_TONG = MOT '1.25*TONG75' ;
  21737. FINSI ;
  21738. SI ( ( YTWIST EGA 0. ) ET ( EGA TAB_1.HELI_WIRE VRAI ) ) ;
  21739. S1 = PI * D1 * D1 / 4. ;
  21740. SM = PI * TAB_1.WIRE_D * TAB_1.WIRE_D / 4. ;
  21741. P1 = PI * D1 ;
  21742. PM = PI * TAB_1.WIRE_D ;
  21743. TAB_1.DH = 4. * ( S1 - SM ) / ( P1 + PM ) ;
  21744. PIS2Y = PI / ( 2 * TAB_1.PITCH_WIRE ) ;
  21745. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  21746. * FACV = 1. ;
  21747. FACF = 1. ;
  21748. FINSI ;
  21749. *
  21750. SI ( ( TAB_1.TWIST_RATIO EGA 0. 1.E-6 ) ET ( EGA TAB_1.HYPERVAP VRAI ) ) ;
  21751. SM = ( TAB_1 . LARG_CANAL * TAB_1 . HMIN_CANAL ) + ( 2. * ( TAB_1 . LARG_ESP * TAB_1 . HFIN ) ) ;
  21752. PM = TAB_1 . LARG_CANAL + ( 2.* TAB_1 . HMAX_CANAL ) + ( 2. * TAB_1 . LARG_ESP ) + ( 2. * TAB_1 . HFIN ) + TAB_1 . LFIN ;
  21753. TAB_1.DH = 4. * SM / PM ;
  21754. FACV = 1. ;
  21755. FACF = 1. ;
  21756. TAB_1.HYP_SM = SM ;
  21757. FACS = 1. ;
  21758. TAB_1.M_TONG = MOT 'TONG75' ;
  21759. FINSI ;
  21760. *
  21761. SI ( YTWIST > 0. ) ;
  21762. SI ( NON ( EXISTE TAB_1 'N_CANAUX' )) ;
  21763. TAB_1 . N_CANAUX = 2. ;
  21764. FINSI ;
  21765. SS2 = ( ( PI * D1 * D1 / 8.) - ( TTAPE * D1 / 2. ) ) ;
  21766. S1 = SS2 * TAB_1 . N_CANAUX ;
  21767. QUAS = 4. * SS2 ;
  21768. PERI = ( ( PI * D1 / 2.) - TTAPE + D1 ) ;
  21769. TAB_1.DH = QUAS / PERI ;
  21770. TAB_1.DHC = 4. * ( ( PI * D1 * D1 / 4.) - ( TTAPE * D1 ) ) / ( ( PI * D1 ) - ( TTAPE * 2.) ) ;
  21771. PIS2Y = PI / ( 2. * YTWIST ) ;
  21772. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  21773. * FACF = 1.15 ;
  21774. FACS = 1.67 ;
  21775. TAB_1.M_TONG = MOT '1.67*TONG75' ;
  21776. FINSI ;
  21777. *-----------------
  21778. VP = VIN * FACV ;
  21779. *-----------------
  21780.  
  21781. SI (( YTWIST > 0. ) ET ( ICORSA EGA 1 ) ) ;
  21782. CORR = SCALE * 2.75 * ( YTWIST ** ( -0.406 ) ) ;
  21783. SI ( CORR &lt;EG 1. ) ;
  21784. CORR = 1. ;
  21785. FINSI ;
  21786. SINON ;
  21787. CORR = 1. ;
  21788. FINSI ;
  21789.  
  21790. RHOIN = @IPOE TIN TAB1.ETRHOF ;
  21791. HSAT = @IPOE TSAT TAB_1.ETHF ;
  21792. RHOGSAT = @IPOE TSAT TAB_1.ETRHOG ;
  21793. GIN = RHOIN * VIN ;
  21794. NNU = @IPOE TLOCAL TAB_1.ETNNU ;
  21795. PR = @IPOE TLOCAL TAB_1.ETPRAF ;
  21796. *HFG = @IPOE TLOCAL TAB_1.ETHFG ;
  21797. HFG = @IPOE TSAT TAB_1.ETHFG ;
  21798. * RHOF rho de l eau a TLOCAL PTRHO PRHOF
  21799. RHOF = @IPOE TLOCAL TAB_1.ETRHOF ;
  21800. RHOFSAT = @IPOE TSAT TAB_1.ETRHOF ;
  21801. DTSUBC = TSAT - TLOCAL ;
  21802.  
  21803. *Reynolds number based on inlet velocity used in QCHFW1 and QCHFW3
  21804. REF = ( RHOF * VIN * TAB_1.DH ) / NNU ;
  21805.  
  21806. * Friction factor calculation
  21807. SI ( EGA TAB_1.FRICT_FAC VRAI ) ;
  21808. FA = 4. * 1.375E-3 * (( 1. + ( 21.544 * ( 0.00375 /( TAB_1.DH * 1000. / 2. ))) + ( 100. / REF )) ** ( 1. / 3. )) ;
  21809. TAB_1.SSIGM = @IPOE TSAT TAB_1.ETSIGM ;
  21810. SIGM = TAB_1.SSIGM ;
  21811. RHOFSAT = @IPOE TSAT TAB_1.ETRHOF ;
  21812. REPETER BOUCFA 100 ;
  21813. RADEFF = 1.14 - ( 2. * ( LOG ((( 0.72 * SIGM * RHOFSAT ) / ( FA * TAB_1.DH * ( GIN**2 ))) + ( 9.35 / ( REF *( FA **( 1. / 2. ))))))/( LOG 10 )) ;
  21814. DIF1 = ( RADEFF ** (-2))- FA ;
  21815. DELTAF = ABS (DIF1) ;
  21816. FA = RADEFF**(-2) ;
  21817. TAB_1.FFA = FA ;
  21818. SI (DELTAF &lt;EG 1.E-6) ;
  21819. QUITTER BOUCFA ;
  21820. FINSI ;
  21821. FIN BOUCFA ;
  21822. QCHFW1 = TAB_1.FFA ;
  21823. SINON ;
  21824. *Reference diameter (0.5 inch) used for friction factor coefficient
  21825. DOM = 12.7E-3 ;
  21826. DRATIO = TAB_1.DH / DOM ;
  21827. QCHFW1 = 8. * ( REF ** ( -.6 ) ) * ( DRATIO ** .32 ) ;
  21828. FINSI ;
  21829. *Water critical pressure
  21830. PCRIT = 22.09E6 ;
  21831. PRATIO = POUT / PCRIT ;
  21832. XOUT = -1. * ( HSAT - HLOCAL ) / HFG ;
  21833. *>> 30.8.93 correction erreur sur JA
  21834. *JA = -1. * XOUT * ( RHOFSAT / RHOGSAT ) ;
  21835. JA = -1. * XOUT * ( RHOF / RHOGSAT ) ;
  21836. QCHFW3 = 1. + ( .00216 * ( PRATIO ** 1.8 ) * ( REF ** .5 ) * JA ) ;
  21837. QCHFW2 = 0.23 * GIN * HFG ;
  21838. QCHFW = FACS * CORR * QCHFW1 * QCHFW2 * QCHFW3 ;
  21839.  
  21840. *Expression using REV
  21841. *Reynolds number based on swirl velocity
  21842. REV = ( RHOF * VP * TAB_1.DH ) / NNU ;
  21843. *QCHFW3 = 1. + ( .00216 * ( PRATIO ** 1.8 ) * ( REV ** .5 ) * JA ) ;
  21844. *QCHFW1 = 8. * ( REV ** ( -.6 ) ) * ( DRATIO ** .32 ) ;
  21845. *QCHFW = FACS * CORR * QCHFW1 * QCHFW2 * QCHFW3 ;
  21846.  
  21847. *QCHFW = ( 0.9 * QCHFW ) + ( 0.1 * QOLD ) ;
  21848. *QSURFE = QCHFW * KQ ;
  21849. *QSURFI = QSURFE * XL1 / PERCH ;
  21850. *DQSQ = ( QCHFW - QOLD ) / QCHFW ;
  21851. *NUS = 0.023 * ( REV ** 0.8 ) * ( PR ** 0.4 ) ;
  21852. *NUS = NUS * FACV * FACF ;
  21853. *FACD = ( D1 / DH ) ** 0.2 ;
  21854. *FACT = FACV * FACD * FACF ;
  21855.  
  21856. SI ( INIVEAU >EG 1 ) ;
  21857. MESS ' ' ;
  21858. MESS '>@TONG75> THERMAL HYDRAULIC CONDITIONS ' ;
  21859. MESS ' ' ;
  21860. MESS '>@TONG75> INLET VELOCITY (m/s) : ' VIN ;
  21861. * MESS '>@TONG75> INLET MASS FLOW RATE (kg/s) : '
  21862. * (VIN * S1 * RHOIN) ;
  21863. * MESS '>@TONG75> FLUID INLET TEMPERATURE (C) : ' TIN ;
  21864. MESS '>@TONG75> FLUID LOCAL TEMPERATURE (C) : ' TLOCAL;
  21865. MESS '>@TONG75> FLUID OUTLET PRESSURE (Pa) : ' POUT ;
  21866. MESS '>@TONG75> WATER SATURATION TEMPERATURE (C) : ' TSAT ;
  21867. MESS '>@TONG75> SUBCOOLING TSAT - TLOCAL (C) : ' DTSUBC;
  21868. MESS ' ' ;
  21869. MESS '>@TONG75> GEOMETRICAL CONDITIONS ' ;
  21870. MESS ' ' ;
  21871. MESS '>@TONG75> TUBE DIAMETER (m) : ' D1 ;
  21872. MESS '>@TONG75> TUBE HYDRAULIC DIAMETER (m) : ' TAB_1.DH ;
  21873. * MESS '>@TONG75> TUBE HEATED EQU. DIAMETER (m) : ' TAB_1.DHC ;
  21874. MESS '>@TONG75> HEATED LENGTH (m) : ' EL ;
  21875. MESS '>@TONG75> HEATED WIDTH (m) : ' XL1 ;
  21876. MESS '>@TONG75> SWIRL TAPE THICKNESS (m) : ' TTAPE ;
  21877. MESS '>@TONG75> TWIST RATIO : ' YTWIST ;
  21878. SI ( INIVEAU >EG 2 ) ;
  21879. MESS '>@TONG75> REYNOLDS NUMBER BASED ON SWIRL VELOCITY : ' REV;
  21880. MESS '>@TONG75> REYNOLDS NUMBER BASED ON VIN : ' REF ;
  21881. MESS '>@TONG75> QUALITY : ' XOUT;
  21882. MESS '>@TONG75> JAKOB NUMBER : ' JA ;
  21883. MESS '>@TONG75> PRANDTL NUMBER : ' PR ;
  21884. MESS '>@TONG75> CORRECTIVE FACTOR SANDIA : ' CORR;
  21885. SI ( INIVEAU >EG 3 ) ;
  21886. MESS '>@TONG75> LOCAL FLUID DENSITY (kg/m**3) : ' RHOF ;
  21887. MESS '>@TONG75> GAS SATUR. DENSITY (kg/m**3) : ' RHOGSAT ;
  21888. MESS '>@TONG75> VAPORISATION ENTHALPY (J/kg) : ' HFG ;
  21889. MESS '>@TONG75> OUTLET FLUID VISCOSITY (kg/m.s) : ' NNU ;
  21890. MESS '>@TONG75> Q1 Q2 Q3 ' QCHFW1 QCHFW2 QCHFW3 ;
  21891. FINSI ;
  21892. FINSI ;
  21893. MESS ' ' ;
  21894. MESS '>@TONG75> : ' TAB_1.M_TONG;
  21895. MESS '>@TONG75> CRITICAL HEAT FLUX (W/m2) : ' QCHFW ;
  21896. MESS ' ' ;
  21897. FINSI ;
  21898. SCALE = 0.8 ;
  21899.  
  21900. SI (QCHFW < 0) ;
  21901. MESS ' ' ;
  21902. MESS '!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!' ;
  21903. MESS ' ' ;
  21904. MESS 'ATTENTION execution incorrecte de @TONG75' ;
  21905. MESS ' ' ;
  21906. MESS '--------------------------------------------' ;
  21907. MESS ' Le flux critique est negatif ' ;
  21908. ERRE ' On arrete le calcul' ;
  21909. FINSI ;
  21910. SI( NIVEAU >EG 4) MESS '-----------------------------------> exit from @TONG75';
  21911. FINSI ;
  21912.  
  21913. *sorties ;
  21914. TAB1.CHF = QCHFW ;
  21915.  
  21916. FINPROC ;
  21917. **** TORO
  21918. DEBPROC TORO TAGEO*TABLE TABOB*TABLE ;
  21919. *
  21920. * Developpement et test de la procedure TORO
  21921. * Projet DRFC/TO_PO Contrat n 30422676
  21922. *
  21923. opti dime 3 elem cub8 echo 0 ;
  21924. **********************************************************************
  21925. * *
  21926. * T O R O *
  21927. * ------- *
  21928. * *
  21929. * Objet: *
  21930. * ----- *
  21931. * *
  21932. * Calcul de l'induction magnetique creee par un ensemble *
  21933. * de bobines circulaires ou en 'D', reparties regulierement *
  21934. * autour de l'axe Oz, en l'absence de fer. *
  21935. * *
  21936. * Syntaxe: *
  21937. * ------- *
  21938. * *
  21939. * TABCHB TAB2 = TORO TAGEO1 TABOB1 ; *
  21940. * *
  21941. * En entree : *
  21942. * *
  21943. * *
  21944. * TAGEO1 table des domaines de calcul du champ *
  21945. * TAGEO1.i geometrie ou le champ est calcule (type TABLE) *
  21946. * TAGEO1.i.'mail' : maillage de la geometrie (type MAILLAGE) *
  21947. * *
  21948. * TABOB table a deux indices contenant les donnees *
  21949. * relatives aux bobines (type TABLE) *
  21950. * .GENE table *
  21951. * .1 nbob: nombre de bobines (type ENTIER) *
  21952. * .2 b: largeur des bobines (type FLOTTANT) *
  21953. * .3 h: hauteur des bobines (type FLOTTANT) *
  21954. * .4 cbob: centre de la bobine (type POINT) *
  21955. * .5 vn: vecteur normal au plan de la bobine (type POINT)*
  21956. * .6 tsol: table des solenations des bobines *
  21957. * .i solenation (courant * nombre de spires) *
  21958. * de la bobine i (type FLOTTANT) *
  21959. * .7 rt: rayon du tore (type FLOTTANT) *
  21960. * .8 ri: nombre de bobines (type FLOTTANT) *
  21961. * .TYPE 'c' pour une bobine circulaire *
  21962. * 'd' pour une bobine en 'D' *
  21963. * .TRAC1 si oui : trace du maillage des bobines (type LOGIQUE) *
  21964. * .CBIOT si oui : calcul de l'induction magnetique *
  21965. * .D = troncon : table des troncons: *
  21966. * troncon.j = troncj : table du troncon j: *
  21967. * troncj.'l' longueur du troncon si rectiligne, *
  21968. * .'r' rayon de courbure et *
  21969. * .'alpha' angle de courbure si courbe *
  21970. * *
  21971. * En sortie : *
  21972. * *
  21973. * *
  21974. * TABCHB table contenant (type TABLE) *
  21975. * i champ de Biot et Savart relatif au i-eme *
  21976. * maillage GEO1 (type CHPOINT) *
  21977. * *
  21978. * TAB2 table contenant (type TABLE) *
  21979. * BOBMAI.i maillage de chaque bobine (type MAILLAGE) *
  21980. * CONT.j ensemble des coupes sur le plan j *
  21981. * (type MAILLAGE) *
  21982. * *
  21983. * Remarques: *
  21984. * --------- *
  21985. * *
  21986. * Les grandeurs suivantes sont "en dur" dans la procedure : *
  21987. * *
  21988. * NELE nombre d'elements generes lors des rotations *
  21989. * et des translations effectuees pendant la *
  21990. * creation du maillage des bobines. *
  21991. * *
  21992. * COEF1 coefficient etablissant la distance critique *
  21993. * de selection des points lors de la recherche *
  21994. * de contour. *
  21995. * *
  21996. **********************************************************************
  21997. isym = 0 ;
  21998. *
  21999. * Valeurs de quelques constantes
  22000. *
  22001. pi = 3.1415926 ;
  22002. mu0 = 4.e-7 * pi ;
  22003. eps = 1.e-3 ;
  22004. nele = 4 ;
  22005. alpha = 90. ;
  22006. oeil = 100. 20. 10. ;
  22007. *
  22008. * creation du maillage
  22009. *
  22010. tab2 = table ;
  22011. tabmai = table ;
  22012. tab2.bobmai = tabmai ;
  22013. ibob = 1 ;
  22014. repeter proc 1 ;
  22015. sauter 1 ligne ;
  22016. mess ' ************ procedure TORO' ;
  22017. sauter 1 ligne ;
  22018. ngeo = dime tageo1 ;
  22019. si (ega ngeo 0) ;
  22020. *tc il ajout d' une quote en fin de la ligne suivante
  22021. mess ' **** Il n y a pas de domaine de calcul' ;
  22022. sinon ;
  22023. si (ega ngeo 1) ;
  22024. mess ' **** Il y a un seul domaine de calcul' ;
  22025. sinon ;
  22026. *tc idem ci dessus
  22027. mess ' **** Il y a' ngeo 'domaines de calcul ';
  22028. finsi ;
  22029. finsi ;
  22030. si (existe tabob type) ;
  22031. typbob = tabob.type ;
  22032. sinon ;
  22033. mess ' *** erreur : indice type inexistant' ;
  22034. quitter proc ;
  22035. finsi ;
  22036. si (existe tabob gene) ;
  22037. tcara = table ;
  22038. tcara = tabob.gene ;
  22039. si (existe tcara 1) ;
  22040. nbob*entier = tcara.1 ;
  22041. sinon ;
  22042. mess ' *** erreur ; il manque nbob !!' ;
  22043. quitter proc ;
  22044. finsi ;
  22045. si (existe tcara 2) ;
  22046. b*flottant = tcara.2 ;
  22047. sinon ;
  22048. mess ' *** erreur ; il manque b !!' ;
  22049. quitter proc ;
  22050. finsi ;
  22051. si (existe tcara 3) ;
  22052. h*flottant = tcara.3 ;
  22053. sinon ;
  22054. mess ' *** erreur ; il manque nbob !!' ;
  22055. quitter proc ;
  22056. finsi ;
  22057. si (existe tcara 4) ;
  22058. cbob*point = tcara.4 ;
  22059. sinon ;
  22060. mess ' *** erreur ; il manque cbob !!' ;
  22061. quitter proc ;
  22062. finsi ;
  22063. si (existe tcara 5) ;
  22064. v*point = tcara.5 ;
  22065. sinon ;
  22066. mess ' *** erreur ; il manque v !!' ;
  22067. quitter proc ;
  22068. finsi ;
  22069. si (existe tcara 6) ;
  22070. tabsol = table ;
  22071. tabsol = tcara.6 ;
  22072. sinon ;
  22073. mess ' *** erreur ; il manque tabsol !!' ;
  22074. quitter proc ;
  22075. finsi ;
  22076. si (existe tcara 7) ;
  22077. rt*flottant = tcara.7 ;
  22078. sinon ;
  22079. mess ' *** erreur ; il manque rt !!' ;
  22080. quitter proc ;
  22081. finsi ;
  22082. si (existe tcara 8) ;
  22083. ri*flottant = tcara.8 ;
  22084. sinon ;
  22085. mess ' *** erreur ; il manque ri !!' ;
  22086. quitter proc ;
  22087. finsi ;
  22088. sinon ;
  22089. mess ' *** erreur : indice gene inexistant' ;
  22090. finsi ;
  22091. *
  22092. si (ega typbob 'c') ;
  22093. sauter 1 ligne ;
  22094. mess ' ******* bobine circulaire *********' ;
  22095. sinon;
  22096. si (ega typbob 'd') ;
  22097. si (existe tabob 'd') ;
  22098. sauter 1 ligne ;
  22099. mess ' ******* bobine en D *********' ;
  22100. sauter 1 ligne ;
  22101. sinon;
  22102. mess ' erreur bobine D : indice d inexistant' ;
  22103. finsi;
  22104. sinon;
  22105. mess '********* erreur bobine ***********' ;
  22106. quitter proc ;
  22107. finsi;
  22108. finsi ;
  22109. *-----------------------------------------------------------------
  22110. * fin de l'analyse syntaxique
  22111. *-----------------------------------------------------------------
  22112. c1 c2 c3 = coor cbob ;
  22113. o1 = cbob plus (0. (0. - rt) 0.) ;
  22114. o2 = o1 plus (0. 0. 10.) ;
  22115. *
  22116. * calcul du vecteur norme vnor normal au plan de la bobine
  22117. *
  22118. v1 v2 v3 = coor v ;
  22119. *
  22120. vn = ( (v1**2) + (v2**2) + (v3**2) )**0.5 ;
  22121. si (vn ega 0.);
  22122. mess ' *** erreur: vecteur vn nul !' ;
  22123. quitter proc ;
  22124. finsi ;
  22125. vn1 = v1/vn ; vn2 = v2/vn ; vn3 = v3/vn ;
  22126. vnor = vn1 vn2 vn3 ;
  22127. ovn = o1 plus (v1 v2 v3) ;
  22128. *
  22129. * calcul du vecteur norme wn normal a vnor (dans le plan de la bobine
  22130. * et dans le plan xOy) et du vecteur t tangent au troncon
  22131. *
  22132. si (vn3 ega 0.);
  22133. t0 = 0. 0. 1. ;
  22134. wn = pvec t0 vnor ;
  22135. sinon ;
  22136. si ( (non (ega vn1 0.)) ou (non (ega vn2 0.)) ) ;
  22137. wn = pvec (0. 0. 1.) vnor ;
  22138. t0 = pvec vnor wn ;
  22139. sinon ;
  22140. wn = 0. 1. 0. ;
  22141. t0 = 1. 0. 0. ;
  22142. finsi ;
  22143. finsi ;
  22144. xt0 yt0 zt0 = coor t0 ;
  22145. t = t0 plus (0. 0. 0.) ;
  22146. wn1 wn2 wn3 = coor wn ;
  22147. *-----------------------------------------------------------
  22148. * test sur le domaine de calcul
  22149. *-----------------------------------------------------------
  22150. itest = table ;
  22151. igeo1 = 0 ;
  22152. repeter bgeo1 ngeo ;
  22153. igeo1 = igeo1 + 1 ;
  22154. si (existe tageo1 igeo1) ;
  22155. lmot = ((tageo1.igeo1).'mail') elem 'TYPE' ;
  22156. nbeldom = nbel (tageo1.igeo1).'mail' ;
  22157. nmot = dime lmot ;
  22158. imot = 0 ;
  22159. repeter boutyp nmot ;
  22160. imot = imot + 1 ;
  22161. mot1 = extr lmot imot ;
  22162. mess ' *** domaine numero' igeo1 'compose de' nbeldom 'elements ' mot1 ;
  22163. sauter 1 ligne ;
  22164. * domaine plan
  22165. si ( (ega mot1 'TRI3') ou (ega mot1 'QUA4') ou (ega mot1 'TRI6') ou (ega mot1 'QUA8') ) ;
  22166. elem1 = ((tageo1.igeo1).'mail') elem 1 ;
  22167. elem2 = chan poi1 elem1 ;
  22168. pel1 = elem2 poin 1 ;
  22169. pel2 = elem2 poin 2 ;
  22170. pel3 = elem2 poin 3 ;
  22171. zpel1 = coor 3 pel1 ;
  22172. zpel2 = coor 3 pel2 ;
  22173. zpel3 = coor 3 pel3 ;
  22174. phori = (ega zpel1 zpel2 1.E-5) et (ega zpel1 zpel3 1.E-5) ;
  22175. si (phori) ;
  22176. (tageo1.igeo1).'ZP' = zpel1 ;
  22177. (tageo1.igeo1).'PP' = pel1 ;
  22178. (tageo1.igeo1).'VP' = 0. 0. 1. ;
  22179. pequa = phori et (ega zpel1 0.) ;
  22180. si (pequa et (ega v3 0.)) ;
  22181. itest.igeo1 = 0 ;
  22182. isym = 1 ;
  22183. sinon ;
  22184. si ((ega typbob 'c') et (ega v3 0.)) ;
  22185. * calcul analytique pour une bobine circulaire verticale
  22186. itest.igeo1 = 1 ;
  22187. sinon ;
  22188. * calcul d'intersection de Denis
  22189. itest.igeo1 = 2 ;
  22190. finsi ;
  22191. finsi ;
  22192. sinon ;
  22193. itest.igeo1 = -2 ;
  22194. finsi ;
  22195. quitter boutyp ;
  22196. sinon ;
  22197. * domaine volumique
  22198. itest.igeo1 = -1 ;
  22199. finsi ;
  22200. fin boutyp ;
  22201. * sauter 1 ligne ;
  22202. * mess ' ****** itest =' itest.igeo1 ;
  22203. * sauter 1 ligne ;
  22204. sinon ;
  22205. quitter bgeo1 ;
  22206. finsi ;
  22207. fin bgeo1 ;
  22208. *--------------------------------------------------------------
  22209. * construction des points de la section initiale de la bobine
  22210. *--------------------------------------------------------------
  22211. re = ri + b ;
  22212. p11 = c1 + (ri*wn1) - ((h/2.)*vn1) ;
  22213. p12 = c2 + (ri*wn2) - ((h/2.)*vn2) ;
  22214. p13 = c3 + (ri*wn3) - ((h/2.)*vn3) ;
  22215. p21 = c1 + (re*wn1) - ((h/2.)*vn1) ;
  22216. p22 = c2 + (re*wn2) - ((h/2.)*vn2) ;
  22217. p23 = c3 + (re*wn3) - ((h/2.)*vn3) ;
  22218. p31 = c1 + (re*wn1) + ((h/2.)*vn1) ;
  22219. p32 = c2 + (re*wn2) + ((h/2.)*vn2) ;
  22220. p33 = c3 + (re*wn3) + ((h/2.)*vn3) ;
  22221. p41 = c1 + (ri*wn1) + ((h/2.)*vn1) ;
  22222. p42 = c2 + (ri*wn2) + ((h/2.)*vn2) ;
  22223. p43 = c3 + (ri*wn3) + ((h/2.)*vn3) ;
  22224. *
  22225. * points de la base
  22226. *
  22227. p1 = p11 p12 p13 ; p2 = p21 p22 p23 ;
  22228. p3 = p31 p32 p33 ; p4 = p41 p42 p43 ;
  22229. * barycentre de la base:
  22230. pp11 = (p11 + p21 + p31 + p41)/4. ;
  22231. pp12 = (p12 + p22 + p32 + p42)/4. ;
  22232. pp13 = (p13 + p23 + p33 + p43)/4. ;
  22233. pp1 = pp11 pp12 pp13 ;
  22234. *
  22235. * segments de la base
  22236. *
  22237. d1 = droi 1 p1 p2 ; d2 = droi 1 p2 p3 ;
  22238. d3 = droi 1 p3 p4 ; d4 = droi 1 p4 p1 ;
  22239. cont1 = p1 d 1 p2 d 1 p3 d 1 p4 d 1 p1 ;
  22240. *
  22241. cvn = cbob plus (vn1 vn2 vn3) ;
  22242. *-----------------------------------------
  22243. * construction des surfaces laterales
  22244. *-----------------------------------------
  22245. si (ega typbob 'c') ;
  22246. tquart = table ;
  22247. pp2 = pp1 tour alpha cbob cvn ;
  22248. *
  22249. surf1 = d1 rota nele alpha cbob cvn ;
  22250. surf2 = d2 rota nele alpha cbob cvn ;
  22251. surf3 = d3 rota nele alpha cbob cvn ;
  22252. surf4 = d4 rota nele alpha cbob cvn ;
  22253. *
  22254. surfbo1 = surf1 et surf2 et surf3 et surf4 ;
  22255. tquart.1 = surfbo1 ;
  22256. xn1 = (vn2*wn3) - (vn3*wn2) ;
  22257. xn2 = (vn3*wn1) - (vn1*wn3) ;
  22258. xn3 = (vn1*wn2) - (vn2*wn1) ;
  22259. p51 = c1 + (ri*xn1) - ((h/2.)*vn1) ;
  22260. p52 = c2 + (ri*xn2) - ((h/2.)*vn2) ;
  22261. p53 = c3 + (ri*xn3) - ((h/2.)*vn3) ;
  22262. p61 = c1 + (re*xn1) + ((h/2.)*vn1) ;
  22263. p62 = c2 + (re*xn2) + ((h/2.)*vn2) ;
  22264. p63 = c3 + (re*xn3) + ((h/2.)*vn3) ;
  22265. p5 = p51 p52 p53 ; p6 = p61 p62 p63 ;
  22266. surfbo2 = surfbo1 syme plan cbob p5 p6 ;
  22267. *
  22268. tquart.2 = surfbo2 ;
  22269. tquart.3 = surfbo2 syme plan cbob p1 p2 ;
  22270. tquart.4 = surfbo1 syme plan cbob p1 p2 ;
  22271. cont2 = cont1 syme plan cbob p5 p6 ;
  22272. demisurf = (surfbo1 et surfbo2) ;
  22273. finsi ;
  22274. *-------------------------------------------------
  22275. si (ega typbob 'd') ;
  22276. troncon = table ;
  22277. troncon = tabob.'d' ;
  22278. ntron = dime troncon ;
  22279. * mess ' ****************** Il y a' ntron 'troncons' ;
  22280. itron = 1 ;
  22281. troncj = table ;
  22282. repeter btron ntron ;
  22283. troncj = troncon.itron ;
  22284. si ( (existe troncj 'l') et (non (existe troncj 'r')) et (non (existe troncj 'alpha')) ) ;
  22285. mess ' ****** troncon no' itron 'rectiligne' ;
  22286. lj = troncj.'l' ;
  22287. si (itron ega 1) ;
  22288. pp2 = pp1 plus ((xt0*lj) (yt0*lj) (zt0*lj)) ;
  22289. vdir = (xt0*lj) (yt0*lj) (zt0*lj) ;
  22290. sinon ;
  22291. xt yt1 zt1 = coor t ;
  22292. xpp2 ypp2 zpp2 = coor pp2 ;
  22293. pp1 = xpp2 ypp2 zpp2 ;
  22294. xg = xt*lj ;
  22295. yg = yt1*lj ;
  22296. zg = zt1*lj ;
  22297. pp2 = pp1 plus (xg yg zg) ;
  22298. vdir = xg yg zg ;
  22299. finsi ;
  22300. surf1 = d1 tran nele vdir ;
  22301. d1 = d1 plus vdir ;
  22302. surf2 = d2 tran nele vdir ;
  22303. d2 = d2 plus vdir ;
  22304. surf3 = d3 tran nele vdir ;
  22305. d3 = d3 plus vdir ;
  22306. surf4 = d4 tran nele vdir ;
  22307. d4 = d4 plus vdir ;
  22308. surfboj = surf1 et surf2 et surf3 et surf4 ;
  22309. *
  22310. * conservation des points definissant le troncon rectiligne
  22311. *
  22312. troncj.'pp1' = pp1 ;
  22313. troncj.'pp2' = pp2 ;
  22314. troncj.'pp3' = cbob ;
  22315. sinon ;
  22316. si ( (existe troncj 'r') et (existe troncj 'alpha') et (non (existe troncj 'l')) ) ;
  22317. mess ' ****** troncon no' itron 'courbe' ;
  22318. rj = troncj.'r' ;
  22319. alphaj = troncj.'alpha' ;
  22320. si (itron ega 1) ;
  22321. si (dbob > 0.) ;
  22322. crj = cbob plus (0. (dbob - rj) 0.) ;
  22323. sinon ;
  22324. crj = cbob plus (0. (dbob + rj) 0.) ;
  22325. finsi ;
  22326. sinon ;
  22327. xpp2 ypp2 zpp2 = coor pp2 ;
  22328. pp1 = xpp2 ypp2 zpp2 ;
  22329. xt yt1 zt1 = coor t ;
  22330. * vecteur norme vr perpendiculaire a vnor et t
  22331. si (alphaj > 0.) ;
  22332. vr = vnor pvec t ;
  22333. sinon ;
  22334. vr = t pvec vnor ;
  22335. finsi ;
  22336. xvr yvr zvr = coor vr ;
  22337. xcrj = xpp2 + ((rj+(b/2.))*xvr) ;
  22338. ycrj = ypp2 + ((rj+(b/2.))*yvr) ;
  22339. zcrj = zpp2 + ((rj+(b/2.))*zvr) ;
  22340. crj = xcrj ycrj zcrj ;
  22341. finsi ;
  22342. cvn = crj plus (vn1 vn2 vn3) ;
  22343. surf1 = d1 rota nele alphaj crj cvn ;
  22344. d1 = d1 tour alphaj crj cvn ;
  22345. surf2 = d2 rota nele alphaj crj cvn ;
  22346. d2 = d2 tour alphaj crj cvn ;
  22347. surf3 = d3 rota nele alphaj crj cvn ;
  22348. d3 = d3 tour alphaj crj cvn ;
  22349. surf4 = d4 rota nele alphaj crj cvn ;
  22350. d4 = d4 tour alphaj crj cvn ;
  22351. surfboj = surf1 et surf2 et surf3 et surf4 ;
  22352. *
  22353. * barycentre de la section finale
  22354. *
  22355. pp2 = pp1 tour alphaj crj cvn ;
  22356. * conservation du point definissant le centre du troncon courbe
  22357. troncj.'crj' = crj ;
  22358. *
  22359. * construction du nouveau vecteur tangent t (par rotation de alphaj)
  22360. *
  22361. t = t tour alphaj o1 ovn ;
  22362. troncj.'pp1' = pp1 ;
  22363. troncj.'pp2' = pp2 ;
  22364. sinon ;
  22365. mess ' erreur : troncon mal defini ' ;
  22366. quitter proc ;
  22367. finsi ;
  22368. finsi ;
  22369. troncj.'mail' = surfboj ;
  22370. si (itron ega 1) ;
  22371. demisurf = surfboj ;
  22372. sinon ;
  22373. demisurf = demisurf et surfboj ;
  22374. finsi ;
  22375. troncon.itron = troncj ;
  22376. itron = itron + 1 ;
  22377. fin btron ;
  22378. cont2 = d1 et d2 et d3 et d4 ;
  22379. elim 1.E-3 cont2 ;
  22380. *---------------------------------------------------------
  22381. * construction des troncons inferieurs par symetrie / xOy
  22382. *---------------------------------------------------------
  22383. si (ega isym 0);
  22384. itron = 1 ;
  22385. repeter btron2 ntron ;
  22386. troncj = troncon.itron ;
  22387. itron2 = (2*ntron) - itron + 1 ;
  22388. troncj2 = table ;
  22389. troncj2.'mail' = (troncj.'mail') syme plan o1 cbob cvn ;
  22390. si ( (existe troncj 'r') et (existe troncj 'alpha') et (non (existe troncj 'l')) ) ;
  22391. crj = (troncj.'crj') syme plan cbob p1 p2 ;
  22392. pp1 = (troncj.'pp2') syme plan cbob p1 p2 ;
  22393. pp2 = (troncj.'pp1') syme plan cbob p1 p2 ;
  22394. troncj2.'crj' = crj ;
  22395. troncj2.'pp1' = pp1 ;
  22396. troncj2.'pp2' = pp2 ;
  22397. troncj2.'r' = troncj.'r' ;
  22398. troncj2.'alpha' = troncj.'alpha' ;
  22399. finsi ;
  22400. si ( (existe troncj 'l') et (non (existe troncj 'r')) et (non (existe troncj 'alpha')) ) ;
  22401. pp1 = (troncj.'pp2') syme plan cbob p1 p2 ;
  22402. pp2 = (troncj.'pp1') syme plan cbob p1 p2 ;
  22403. troncj2.'pp1' = pp1 ;
  22404. troncj2.'pp2' = pp2 ;
  22405. troncj2.'pp3' = cbob ;
  22406. troncj2.'l' = troncj.'l' ;
  22407. finsi ;
  22408. troncon.itron2 = troncj2 ;
  22409. itron = itron + 1 ;
  22410. fin btron2 ;
  22411. finsi ;
  22412. finsi ;
  22413. *----------------------------------------------------------------------
  22414. * construction du symetrique du maillage de la bobine par rapport a xOy
  22415. *----------------------------------------------------------------------
  22416. surfbob = demisurf et (demisurf syme plan cbob p1 p2 ) ;
  22417. elim eps surfbob ;
  22418. mess 'construction de la premiere bobine effectuee' ;
  22419. *-----------------------------------------------------------
  22420. * construction des autres bobines par rotation autour de Oz
  22421. *-----------------------------------------------------------
  22422. ibob = 1 ;
  22423. tabmai.ibob = surfbob ;
  22424. surftot = surfbob ;
  22425. si (nbob > 1) ;
  22426. repeter bbob (nbob-1) ;
  22427. ibob = ibob + 1 ;
  22428. angln = (ibob-1)*360./nbob ;
  22429. surfbobn = surfbob tour angln o1 o2 ;
  22430. tabmai.ibob = surfbobn ;
  22431. surftot = surftot et tabmai.ibob ;
  22432. mess 'construction de la bobine' ibob 'effectuee' ;
  22433. fin bbob ;
  22434. finsi ;
  22435. *
  22436. * construction des axes
  22437. *
  22438. x1 = (2.*rt) 0. 0. ;
  22439. y1 = 0. (2.*rt) 0. ;
  22440. z1 = 0. 0. (2.*rt) ;
  22441. axes = (o1 d 1 x1) et (o1 d 1 y1) et (o1 d 1 z1) ;
  22442. axes = axes coul rouge ;
  22443. si (ega tabob.trac1 'oui') ;
  22444. trac oeil cach (surftot et axes) ;
  22445. finsi ;
  22446. fin proc ;
  22447. ****************************************
  22448. * calcul des champs de biot et savart *
  22449. ****************************************
  22450. tabchb = table ;
  22451. tab2.cont = table ;
  22452. re = ri + b ;
  22453. igeo1 = 0 ;
  22454. si (ega tabob.cbiot 'oui') ;
  22455. repeter bogeo1 ngeo ;
  22456. igeo1 = igeo1 + 1 ;
  22457. mess ' *** Domaine de calcul du champ numero' igeo1 ;
  22458. si (itest.igeo1 > -1) ;
  22459. tabcon = table ;
  22460. finsi ;
  22461. si (existe tageo1 igeo1) ;
  22462. geo1 = (tageo1.igeo1).'mail' ;
  22463. chp0 = manu chpo geo1 3 bx 0. by 0. bz 0. ;
  22464. ibob = 0 ;
  22465. repeter bbob2 nbob ;
  22466. ibob = ibob + 1 ;
  22467. si (existe tabsol ibob) ;
  22468. sol = tabsol.ibob ;
  22469. dens = sol/(b*h) ;
  22470. finsi ;
  22471. si (ega typbob 'c') ;
  22472. mess ' *** BIOT ; induction magnetique cree par ' 'la bobine circulaire numero' ibob ;
  22473. mess 'dont la solenation est' sol ;
  22474. sauter 1 ligne ;
  22475. si (ega ibob 1) ;
  22476. chb1 = biot geo1 cerc cbob pp1 pp2 ri re h dens mu0 ;
  22477. sinon ;
  22478. anglj = 360./nbob ;
  22479. cbob = cbob tour anglj o1 o2 ;
  22480. pp1 = pp1 tour anglj o1 o2 ;
  22481. pp2 = pp2 tour anglj o1 o2 ;
  22482. chb1 = chb1 et (biot geo1 cerc cbob pp1 pp2 ri re h dens mu0) ;
  22483. finsi ;
  22484. sinon ;
  22485. sauter 1 ligne ;
  22486. mess ' *** BIOT ; induction magnetique cree par ' 'la bobine en D numero' ibob ;
  22487. mess 'dont la solenation est' sol ;
  22488. sauter 1 ligne ;
  22489. itron = 0 ;
  22490. ntron = dime troncon ;
  22491. repeter bbob3 ntron ;
  22492. itron = itron + 1 ;
  22493. troncj = troncon.itron ;
  22494. *
  22495. * troncon courbe
  22496. *
  22497. si ( (existe troncj 'r') et (existe troncj 'alpha') ) ;
  22498. * mess ' troncon numero' itron;
  22499. ri = troncj.'r' ;
  22500. re = ri + b ;
  22501. crj = troncj.'crj' ;
  22502. pp1 = troncj.'pp1' ;
  22503. pp2 = troncj.'pp2' ;
  22504. * mess '** ri' ri ;
  22505. * list crj ;
  22506. * list pp1 ;
  22507. * list pp2 ;
  22508. si ( (ega ibob 1) et (ega itron 1) ) ;
  22509. mess ' *** premier troncon courbe ' ;
  22510. chb1 = biot geo1 arc crj pp1 pp2 ri re h dens mu0 ;
  22511. sinon ;
  22512. mess ' *** troncon courbe numero' itron;
  22513. si (ibob > 1) ;
  22514. teta = (ibob - 1)*360./nbob ;
  22515. tcrj = crj tour teta o1 o2 ;
  22516. tpp1 = pp1 tour teta o1 o2 ;
  22517. tpp2 = pp2 tour teta o1 o2 ;
  22518. chb1j = biot geo1 arc tcrj tpp1 tpp2 ri re h dens mu0 ;
  22519. chb1 = chb1 et chb1j ;
  22520. sinon ;
  22521. chb1j = biot geo1 arc crj pp1 pp2 ri re h dens mu0 ;
  22522. chb1 = chb1 et chb1j ;
  22523. finsi ;
  22524. finsi ;
  22525. finsi ;
  22526. *
  22527. * troncon rectiligne
  22528. *
  22529. si (existe troncj 'l') ;
  22530. * mess ' troncon numero' itron;
  22531. pp1 = troncj.'pp1' ;
  22532. pp2 = troncj.'pp2' ;
  22533. pp3 = troncj.'pp3' ;
  22534. * list pp1 ;
  22535. * list pp2 ;
  22536. * list pp3 ;
  22537. si ((ega ibob 1) et (ega itron 1));
  22538. mess ' *** premier troncon rectiligne' ;
  22539. chb1 = biot geo1 barr pp1 pp2 pp3 b h dens mu0 ;
  22540. sinon ;
  22541. mess ' *** troncon rectiligne numero' itron;
  22542. si (ibob > 1) ;
  22543. teta = (ibob - 1)*360./nbob ;
  22544. tpp1 = pp1 tour teta o1 o2 ;
  22545. tpp2 = pp2 tour teta o1 o2 ;
  22546. tpp3 = pp3 tour teta o1 o2 ;
  22547. chb1j = biot geo1 barr tpp1 tpp2 tpp3 b h dens mu0 ;
  22548. chb1 = chb1 et chb1j ;
  22549. sinon ;
  22550. chb1j = biot geo1 barr pp1 pp2 pp3 b h dens mu0 ;
  22551. chb1 = chb1 et chb1j ;
  22552. finsi ;
  22553. finsi ;
  22554. finsi ;
  22555. si (ega isym 1) ;
  22556. mess ' ***** calcul du champ par symetrie / xOy ' ;
  22557. si ( (ega ibob 1) et (ega itron 1) ) ;
  22558. chb1x = exco 'BX' chb1 'BX' ;
  22559. chb1y = exco 'BY' chb1 'BY' ;
  22560. chb1z = exco 'BZ' chb1 'BZ' ;
  22561. chb2z = chb1z*(-1.) ;
  22562. chb2 = chb1x et chb1y et chb2z ;
  22563. chb1 = chb1 et chb2 ;
  22564. sinon ;
  22565. chb1x = exco 'BX' chb1j 'BX' ;
  22566. chb1y = exco 'BY' chb1j 'BY' ;
  22567. chb1z = exco 'BZ' chb1j 'BZ' ;
  22568. chb2z = chb1z*(-1.) ;
  22569. chb2 = chb1x et chb1y et chb2z ;
  22570. chb1 = chb1 et chb2 ;
  22571. finsi ;
  22572. finsi ;
  22573. fin bbob3 ;
  22574. finsi ;
  22575. fin bbob2 ;
  22576. tabchb.igeo1 = chb1 ;
  22577. *----------------------------------------------------
  22578. * calcul des intersections pour le plan igeo1
  22579. *----------------------------------------------------
  22580. si (ega itest.igeo1 0) ;
  22581. tabcon.1 = cont1 et cont2 ;
  22582. finsi ;
  22583. si (ega itest.igeo1 1) ;
  22584. *----------------------------------------------------------------
  22585. * calcul analytique de l'intersection d'une bobine circulaire
  22586. * verticale avec un plan
  22587. *----------------------------------------------------------------
  22588. mess ' **** calcul analytique dans le cas' 'de la bobine circulaire' ;
  22589. sauter 1 ligne ;
  22590. zp = (tageo1.igeo1).'ZP' ;
  22591. mess ' **** plan a la cote' zp ;
  22592. x1 = h/2.;
  22593. cbob*point = tcara.4 ;
  22594. cxn = cbob plus (1. 0. 0.) ;
  22595. czn = cbob plus (0. 0. 1.) ;
  22596. si (zp < ri) ;
  22597. cos1 = ((ri**2.) - (zp**2.) )**0.5 ;
  22598. beta1 = atg zp cos1 ;
  22599. y1 = ri*(cos beta1) ;
  22600. pc1 = cbob plus (x1 y1 zp) ;
  22601. pc2 = cbob plus ( (0. - x1) y1 zp ) ;
  22602. *
  22603. cos2 = ((re**2.) - (zp**2.) )**0.5 ;
  22604. beta2 = atg zp cos2 ;
  22605. y2 = re*(cos beta2) ;
  22606. pc3 = cbob plus (x1 y2 zp) ;
  22607. pc4 = cbob plus ( (0. - x1) y2 zp ) ;
  22608. *
  22609. cont1 = pc1 d 1 pc2 d 1 pc4 d 1 pc3 d 1 pc1 ;
  22610. tabcon.1 = cont1 et (cont1 syme plan cbob cxn czn) ;
  22611. sinon ;
  22612. si (zp < re) ;
  22613. cos2 = ((re**2.)- (zp**2.) )**0.5 ;
  22614. beta2 = atg zp cos2 ;
  22615. y2 = re*(cos beta2) ;
  22616. pc1 = cbob plus (x1 y2 zp) ;
  22617. pc2 = cbob plus ( (0. - x1) y2 zp ) ;
  22618. pc3 = pc2 syme plan cbob cxn czn ;
  22619. pc4 = pc1 syme plan cbob cxn czn ;
  22620. cont1 = pc1 d 1 pc2 d 1 pc3 d 1 pc4 d 1 pc1 ;
  22621. tabcon.1 = cont1 ;
  22622. sinon ;
  22623. mess ' ***** le plan ne coupe pas les bobines !!' ;
  22624. finsi ;
  22625. finsi ;
  22626. si (non (ega vn2 0.)) ;
  22627. gama1 = atg vn2 vn1 ;
  22628. tabcon.1 = tabcon.1 tour gama1 cbob czn ;
  22629. finsi ;
  22630. finsi ;
  22631. si (ega itest.igeo1 2) ;
  22632. * mess 'Algorithme Denis Robert' ;
  22633. *------------------------------------------------------------------
  22634. * Algorithme de recherche des contours des bobines
  22635. *------------------------------------------------------------------
  22636. repeter bouci 1 ;
  22637. 'SAUTER' 1 'LIGNE' ;
  22638. 'MESS' 'Contour des bobines dans le domaine' igeo1 ;
  22639. 'MESS' '-------------------------------------------' ;
  22640. TABLIG = TABLE ;
  22641. TAB2.LIG = TABLIG ;
  22642. COUP1 = tageo1.igeo1 ;
  22643. IRECUP = 0 ;
  22644. 'SI' ( 'EXISTE' COUP1 'PP' ) ;
  22645. PP*'POINT' = COUP1.'PP' ;
  22646. 'SINON' ;
  22647. 'SAUTER' 1 'LIGNE' ;
  22648. 'MESS' 'Erreur : il manque PP pour le plan ' igeo1 ;
  22649. 'SAUTER' 1 'LIGNE' ;
  22650. IERR = 1 ; 'QUITTER' BOUCI;
  22651. 'FINSI' ;
  22652. 'SI' ( 'EXISTE' COUP1 'VP' ) ;
  22653. VP*'POINT' = COUP1.'VP' ;
  22654. 'SINON' ;
  22655. 'SAUTER' 1 'LIGNE' ;
  22656. 'MESS' 'Erreur : il manque VP pour le plan ' igeo1 ;
  22657. 'SAUTER' 1 'LIGNE' ;
  22658. IERR = 1 ; 'QUITTER' BOUCI ;
  22659. 'FINSI' ;
  22660. *
  22661. * Trois points vont definir ce plan : PP PP2 et PP3
  22662. *
  22663. PP11 PP12 PP13 = COORD PP ;
  22664. VP1 VP2 VP3 = COORD VP ;
  22665. *
  22666. * Vecteur WN tq : VP1 WN1 + VP2 WN2 + VP3 WN3 = 0
  22667. *
  22668. VPN1 = ( (VP1**2) + (VP2**2) + (VP3**2) ) ** 0.5 ;
  22669. 'SI' ( VPN1 'EGA' 0. ) ;
  22670. 'SAUTER' 1 'LIGNE' ;
  22671. 'MESS' 'ERREUR : plan ' igeo1 ' le vecteur VP est nul' ;
  22672. 'SAUTER' 1 'LIGNE' ;
  22673. IERR = 1 ; 'QUITTER' BOUCI ;
  22674. 'FINSI' ;
  22675. VN1 = VP1 / VPN1 ; VN2 = VP2 / VPN1 ; VN3 = VP3 / VPN1 ;
  22676. VPN = VN1 VN2 VN3 ;
  22677. 'SI' ( VN1 'NEG' 0. ) ;
  22678. 'SI' ( VN2 'NEG' 0. ) ;
  22679. 'SI' ( VN3 'NEG' 0. ) ;
  22680. W2 = VN3 / VN2 ; W3 = -1 ;
  22681. WN = ( (W2**2) + (W3**2) ) ** 0.5 ;
  22682. WN1 = 0. ; WN2 = W2 / WN ; WN3 = W3 / WN ;
  22683. 'SINON' ;
  22684. WN1 = 0. ; WN2 = 0. ; WN3 = 1. ;
  22685. 'FINSI' ;
  22686. 'SINON' ;
  22687. 'SI' ( VN3 'NEG' 0. ) ;
  22688. WN1 = 0. ; WN2 = 1. ; WN3 = 0. ;
  22689. 'SINON' ;
  22690. WN1 = 0. ; WN2 = 0. ; WN3 = 1. ;
  22691. 'FINSI' ;
  22692. 'FINSI' ;
  22693. 'SINON' ;
  22694. WN1 = 1. ; WN2 = 0. ; WN3 = 0. ;
  22695. 'FINSI' ;
  22696. *
  22697. XN1 = (VN2 * WN3) - (VN3 * WN2) ;
  22698. XN2 = (VN3 * WN1) - (VN1 * WN3) ;
  22699. XN3 = (VN1 * WN2) - (VN2 * WN1) ;
  22700. *
  22701. * WN et XN forment une base du plan de coupe
  22702. *
  22703. PP21 = PP11 + WN1 ; PP22 = PP12 + WN2 ;
  22704. PP23 = PP13 + WN3 ; PP31 = PP11 + XN1 ;
  22705. PP32 = PP12 + XN2 ; PP33 = PP13 + XN3 ;
  22706. PP2 = PP21 PP22 PP23 ; PP3 = PP31 PP32 PP33 ;
  22707. *
  22708. * Intersection de ce plan avec la bobine IBO
  22709. *
  22710. IINTER = 0 ;
  22711. *
  22712. * On traite separement chaque troncon
  22713. *
  22714. IINTEI = 0 ;
  22715. itron = 0 ;
  22716. si (ega typbob 'd') ;
  22717. ntron = dime tabob.'d' ;
  22718. sinon ;
  22719. ntron = 4 ;
  22720. finsi ;
  22721. 'REPETER' boutron ntron ;
  22722. itron = itron + 1 ;
  22723. si (ega typbob 'd') ;
  22724. MAI0 = (tabtron.itron).'mail' ;
  22725. sinon ;
  22726. MAI0 = tquart.itron ;
  22727. finsi ;
  22728. MAI1 = 'CHANGER' 'POI1' MAI0 ;
  22729. NBP1 = 'NBNO' MAI1 ;
  22730. 'MESS' '---> troncon de bobine : ' itron ;
  22731. 'MESS' '---> Nbre de pts : ' NBP1 ;
  22732. IP1 = 1 ;
  22733. IDESSOUS = 0 ; IDESSUS = 0 ; IDEDANS = 0 ;
  22734. DMOY = 0. ;
  22735. 'REPETER' BOUCPOI1 NBP1 ;
  22736. PO1 = MAI1 'POIN' IP1 ;
  22737. POX1 POY1 POZ1 = 'COORD' PO1 ;
  22738. MX1 = POX1 - PP11 ; MY1 = POY1 - PP12 ;
  22739. MZ1 = POZ1 - PP13 ; M1 = MX1 MY1 MZ1 ;
  22740. PDT1 = M1 'PSCAL' VPN ;
  22741. DMOY = DMOY + ('ABS' (PDT1)) ;
  22742. 'SI' ( ( 'ABS' PDT1 ) < 0.001 ) ;
  22743. IDEDANS = IDEDANS + 1 ;
  22744. 'FINSI' ;
  22745. 'SI' ( PDT1 '&lt;EG' -0.001 ) ;
  22746. IDESSOUS = IDESSOUS + 1 ;
  22747. 'FINSI' ;
  22748. 'SI' ( PDT1 '>EG' 0.001 ) ;
  22749. IDESSUS = IDESSUS + 1 ;
  22750. 'FINSI' ;
  22751. 'SI' ( IP1 'EGA' 1 ) ;
  22752. LISPDT = 'PROG' PDT1 ;
  22753. 'SINON' ;
  22754. LISPDT = LISPDT 'ET' ( 'PROG' PDT1 ) ;
  22755. 'FINSI' ;
  22756. IP1 = IP1 + 1 ;
  22757. 'FIN' BOUCPOI1 ;
  22758. *+*
  22759. *+* Distance de selection des points a projeter
  22760. *+* on divise DMOY par 2 si NELE = 4
  22761. *+* 3 8
  22762. COEF1 = 2. ;
  22763. DMOY = DMOY / NBP1 ;
  22764. DCRIT = DMOY / COEF1 ;
  22765. *
  22766. * tests sur la repartition des points / plan de coupe
  22767. *
  22768. 'SI' ( IDEDANS '>EG' 4 ) ;
  22769. ICAS = 1 ;
  22770. 'SINON' ;
  22771. 'SI' ( IDESSUS > IDESSOUS ) ;
  22772. ICAS = 2 ;
  22773. 'SINON' ;
  22774. ICAS = 3 ;
  22775. 'FINSI' ;
  22776. 'FINSI' ;
  22777. *
  22778. 'SI' ((( IDESSOUS '>EG' 1 ) 'ET' ( IDESSUS '>EG' 1 )) 'OU' ( IDEDANS '>EG' 1 )) ;
  22779. IINTER = IINTER + 1 ;
  22780. IINTEI = IINTEI + 1 ;
  22781. 'MESS' 'Il y a une intersection ...' ;
  22782. *
  22783. * On ne retient que les points les plus proches du
  22784. * plan de coupe Pc
  22785. *
  22786. IREC = 0 ;
  22787. 'REPETER' BOUCREC 7 ;
  22788. IREC = IREC + 1 ;
  22789. IP2 = 1 ; IOK = 0 ;
  22790. 'REPETER' BOUCTRI NBP1 ;
  22791. VAL1 = 'EXTRAIRE' LISPDT IP2 ;
  22792. 'SI' ( ( ICAS 'EGA' 1 ) et (('ABS' VAL1 ) '&lt;EG' 0.001) );
  22793. IOK = IOK + 1 ;
  22794. 'SI' ( IOK 'EGA' 1 ) ;
  22795. MAI2 = MAI1 'POIN' IP2 ;
  22796. 'SINON' ;
  22797. MAI2 = MAI2 'ET' ( MAI1 'POIN' IP2 ) ;
  22798. 'FINSI' ;
  22799. 'FINSI ' ;
  22800. 'SI' ( ( ICAS 'EGA' 2 ) et ((('ABS' VAL1 ) '&lt;EG' DCRIT ) 'ET' ( VAL1 '>EG' 0.001)) );
  22801. IOK = IOK + 1 ;
  22802. 'SI' ( IOK 'EGA' 1 ) ;
  22803. MAI2 = MAI1 'POIN' IP2 ;
  22804. 'SINON' ;
  22805. MAI2 = MAI2 'ET' ( MAI1 'POIN' IP2 ) ;
  22806. 'FINSI' ;
  22807. 'FINSI' ;
  22808. 'SI' ( (ICAS 'EGA' 3 ) et ((('ABS' VAL1 ) '&lt;EG' DCRIT ) 'ET' (VAL1 < -0.001)) );
  22809. IOK = IOK + 1 ;
  22810. 'SI' ( IOK 'EGA' 1 ) ;
  22811. MAI2 = MAI1 'POIN' IP2 ;
  22812. 'SINON' ;
  22813. MAI2 = MAI2 'ET' ( MAI1 'POIN' IP2 ) ;
  22814. 'FINSI' ;
  22815. 'FINSI' ;
  22816. IP2 = IP2 + 1 ;
  22817. 'FIN' BOUCTRI ;
  22818. list iok ;
  22819. si (iok > 1) ;
  22820. NBP2 = 'NBNO' MAI2 ;
  22821. sinon ;
  22822. NBP2 = 1 ;
  22823. finsi ;
  22824. 'MESS' '---> Distance critique : ' DCRIT ;
  22825. 'MESS' '---> Nbre de points retenus : ' NBP2 ;
  22826. 'MESS' '---> iok : ' iok ;
  22827. 'SI' ( NBP2 < 4 ) ;
  22828. 'SI' ( IREC '&lt;EG' 6 ) ;
  22829. 'MESS' 'Pas assez de points selectionnes' ;
  22830. 'MESS' 'essai nouvelle distance critique' ;
  22831. DCRIT = DCRIT * 1.25 ;
  22832. 'SINON' ;
  22833. 'MESS' 'Mauvaise selection des points : ' ;
  22834. 'MESS' 'contour introuvable !' ;
  22835. IERR = 1 ; 'QUITTER' BOUCREC ;
  22836. 'FINSI' ;
  22837. 'SINON' ;
  22838. 'QUITTER' BOUCREC ;
  22839. 'FINSI' ;
  22840. 'FIN' BOUCREC ;
  22841. si (ega iok 1) ;
  22842. iterer boutron ;
  22843. mess ' *** Il y a un point selectionne ! ' ;
  22844. finsi ;
  22845. *
  22846. * Construction de LIGi
  22847. *
  22848. POIPROJ = MAI2 'PROJ' VP 'PLAN' PP PP2 PP3 ;
  22849. *
  22850. * recherche de WMIN, XWMIN et d'un point oppose
  22851. *
  22852. II1 = 1 ;
  22853. NBP1 = 'NBNO' POIPROJ ;
  22854. 'REPETER' BOUCP1 NBP1 ;
  22855. PE1 = POIPROJ 'POIN' II1 ;
  22856. PEX1 PEY1 PEZ1 = 'COORD' PE1 ;
  22857. VV1 = PEX1 - PP11 ;
  22858. VV2 = PEY1 - PP12 ;
  22859. VV3 = PEZ1 - PP13 ;
  22860. PEW1 = (VV1 * WN1) + (VV2 * WN2) + (VV3 * WN3) ;
  22861. PEX1 = (VV1 * XN1) + (VV2 * XN2) + (VV3 * XN3) ;
  22862. 'SI' ( II1 'EGA' 1 ) ;
  22863. LW = 'PROG' PEW1 ; LX = 'PROG' PEX1 ;
  22864. WMIN = PEW1 ; XWMIN = PEX1 ;
  22865. IIMIN = 1 ;
  22866. 'SINON' ;
  22867. LW = LW 'ET' ( 'PROG' PEW1 ) ;
  22868. LX = LX 'ET' ( 'PROG' PEX1 ) ;
  22869. 'SI' ( PEW1 < WMIN ) ;
  22870. WMIN = PEW1 ; XWMIN = PEX1 ;
  22871. IIMIN = II1 ;
  22872. 'FINSI' ;
  22873. 'FINSI' ;
  22874. II1 = II1 + 1 ;
  22875. 'FIN' BOUCP1 ;
  22876. *
  22877. II2 = 1 ; DIAG0 = 0. ;
  22878. 'REPETER' BOUCP2 NBP1 ;
  22879. LW1 = 'EXTRAIRE' LW II2 ;
  22880. LX1 = 'EXTRAIRE' LX II2 ;
  22881. DIAG1 = ( ((LW1 - WMIN) ** 2) + ((LX1 - XWMIN) ** 2) ) ** 0.5 ;
  22882. 'SI' ( DIAG1 > DIAG0 ) ;
  22883. DIAG0 = DIAG1 ;
  22884. IIMAX = II2 ;
  22885. 'FINSI' ;
  22886. II2 = II2 + 1 ;
  22887. 'FIN' BOUCP2 ;
  22888. PC1 = POIPROJ 'POIN' IIMIN ;
  22889. PCX1 PCY1 PCZ1 = 'COORD' PC1 ;
  22890. PC2 = POIPROJ 'POIN' IIMAX ;
  22891. PCX2 PCY2 PCZ2 = 'COORD' PC2 ;
  22892. *
  22893. * PQ = PC2 - PC1
  22894. *
  22895. PQX1 = PCX2 - PCX1;
  22896. PQY1 = PCY2 - PCY1;
  22897. PQZ1 = PCZ2 - PCZ1;
  22898. PQ = PQX1 PQY1 PQZ1 ;
  22899. *
  22900. * PN = PQ ^ VN
  22901. *
  22902. PNX1 = (PQY1 * VN3) - (PQZ1 * VN2) ;
  22903. PNY1 = (PQZ1 * VN1) - (PQX1 * VN3) ;
  22904. PNZ1 = (PQX1 * VN2) - (PQY1 * VN1) ;
  22905. PN = PNX1 PNY1 PNZ1 ;
  22906. *
  22907. * Recherche des deux autres points -> PC3 et PC4
  22908. *
  22909. II3 = 1 ;
  22910. PSCAMAX = 0. ; PSCAMIN = 0. ;
  22911. 'REPETER' BOUCP3 NBP1 ;
  22912. PE1 = POIPROJ 'POIN' II3 ;
  22913. PEX1 PEY1 PEZ1 = 'COORD' PE1 ;
  22914. VV1 = PEX1 - PCX1 ;
  22915. VV2 = PEY1 - PCY1 ;
  22916. VV3 = PEZ1 - PCZ1 ;
  22917. PSC1 = (VV1 * PNX1) + (VV2 * PNY1) + (VV3 * PNZ1) ;
  22918. 'SI' ( PSC1 > PSCAMAX ) ;
  22919. PSCAMAX = PSC1 ; IIMAX = II3 ;
  22920. 'FINSI' ;
  22921. 'SI' ( PSC1 < PSCAMIN ) ;
  22922. PSCAMIN = PSC1 ; IIMIN = II3 ;
  22923. 'FINSI' ;
  22924. II3 = II3 + 1 ;
  22925. 'FIN' BOUCP3 ;
  22926. PC3 = POIPROJ 'POIN' IIMAX ;
  22927. PC4 = POIPROJ 'POIN' IIMIN ;
  22928. L1 = 'DROITE' 1 PC1 PC3 ; L2 = 'DROITE' 1 PC3 PC2 ;
  22929. L3 = 'DROITE' 1 PC2 PC4 ; L4 = 'DROITE' 1 PC4 PC1 ;
  22930. LIG1 = L1 'ET' L2 'ET' L3 'ET' L4 ;
  22931. LIG1 = LIG1 'COUL' vert ;
  22932. mess ' ***** iinter =' iinter ;
  22933. 'SI' (IINTER 'EGA' 1) ;
  22934. LB = LIG1 ;
  22935. 'SINON' ;
  22936. LB = LB 'ET' LIG1 ;
  22937. 'FINSI' ;
  22938. 'SINON' ;
  22939. 'DETR' MAI1 ; 'DETR' LISPDT ;
  22940. 'FINSI' ;
  22941. * IMAI = IMAI + 1 ;
  22942. 'FIN' boutron ;
  22943. 'SI' ( IINTEI '>EG' 1 ) ;
  22944. 'MESS' 'Dans le plan' igeo1 ',' iintei 'contours ont ete crees' ;
  22945. sinon ;
  22946. mess ' **** il n y a pas d intersection dans le plan' igeo1 ;
  22947. 'FINSI' ;
  22948. 'FIN' BOUCI ;
  22949. *
  22950. * Archivage de l'intersection dans TAB2.LIG.j
  22951. *
  22952. 'SI' (( IINTER '>EG' 1 ) 'OU' ( IRECUP 'EGA' 1 )) ;
  22953. tabcon.1 = LB ;
  22954. 'FINSI' ;
  22955. sauter 1 ligne ;
  22956. mess ' ************ fin du calcul des intersections *******' ;
  22957. finsi ;
  22958. sinon ;
  22959. iterer bogeo1 ;
  22960. finsi ;
  22961. si (ega itest.igeo1 -2) ;
  22962. mess ' **** le plan de calcul choisi n est pas horizontal!!' ;
  22963. finsi ;
  22964. *-------------------------------------------------------------------------
  22965. *
  22966. * construction des contours des autres bobines par rotation autour de Oz
  22967. *
  22968. *-------------------------------------------------------------------------
  22969. si ((itest.igeo1) > -1) ;
  22970. si (existe tabcon 1) ;
  22971. si (nbob > 1) ;
  22972. ibob = 1 ;
  22973. contot = tabcon.ibob ;
  22974. repeter bbob2 (nbob-1) ;
  22975. ibob = ibob + 1 ;
  22976. angln = (ibob-1)*360./nbob ;
  22977. tabcon.ibob = tabcon.1 tour angln o1 o2 ;
  22978. contot = contot et tabcon.ibob ;
  22979. fin bbob2 ;
  22980. finsi ;
  22981. finsi ;
  22982. (tab2.cont).igeo1 = tabcon ;
  22983. sinon ;
  22984. (tab2.cont).igeo1 = 0 ;
  22985. finsi ;
  22986. fin bogeo1 ;
  22987. finsi ;
  22988. sauter 1 ligne ;
  22989. mess ' *** Fin normale de la procedure TORO ***' ;
  22990. sauter 1 ligne ;
  22991. finproc tabchb tab2 ;
  22992. **** TOTAL
  22993. ****************************************************
  22994. ****** PROCEDURE TOTAL ******
  22995. *-------------------------------------------------
  22996. DEBPROC TOTAL CH1*CHPOINT GEO*MAILLAGE COMP1*MOT ;
  22997. CH2 = REDU CH1 GEO ;
  22998. CHTOT = RESU CH2 ;
  22999. P1 = (EXTR CHTOT MAIL) POIN 1 ;
  23000. *MESS 'RESULTANTE DE LA COMPOSANTE ' COMP1 ;
  23001. TOT1 = EXTR CHTOT COMP1 P1 ;
  23002. *LIST TOT1 ;
  23003. FINPROC TOT1 ;
  23004. *-------------------------------------------------
  23005. **** @TPERM
  23006. 'DEBPROC' @TPERM TAB1*'TABLE ' ;
  23007. SI ( TAB1.PERMANENT ) ;
  23008.  
  23009. MESS '>>>>> 4.10 >>>>>>' ;
  23010.  
  23011. COTETF1 = TAB1.C_COTETF1 ;
  23012. SITETF1 = TAB1.C_SITETF1 ;
  23013. COTETR1 = TAB1.C_COTETR1 ;
  23014. SITETR1 = TAB1.C_SITETR1 ;
  23015. COTETC1 = TAB1.C_COTETC1 ;
  23016. SITETC1 = TAB1.C_SITETC1 ;
  23017. TAC2 = TABLE;
  23018. TAB1.I_FPAT1 = TABLE;
  23019. TAB1.FLUX_CRITIQUE = TABLE;
  23020. TAB1.EV_FLUX_CONV = TABLE;
  23021. TAB1.EV_FLUX_RAYO = TABLE;
  23022. TAB1.FLJB_CRI_TONG = TABLE;
  23023. TAB1.RESUTHER = TABLE;
  23024. TAB1.RESUTHER.COEFECHANGE = TABLE;
  23025. TAB1.RESUTHER.VALEUR_TETA = TABLE;
  23026. TAB1.RESUTHER.COEFRAYONNE = TABLE;
  23027. TAB1.RESUTHER.CONDUCMAT = TABLE;
  23028. *
  23029. *======== DEBUT BOUCLE : DIFFERENTES VALEURS DE FLUX INCIDENT
  23030. *
  23031. I_11 = 0;
  23032. REPETER BOCA ( DIME TAB1.LIS_FLUX );
  23033. I_11 = I_11 + 1;
  23034. TAB1.'ITER'= I_11;
  23035. *********** cas LAMBDAQ VPAT1 = exp*sinus
  23036. *********** cas LAMBDAQ SOM1 = somme ( exp*sinus)
  23037. *********** cas LAMBDAQ FACFM1 = SOM1 / largeur (v. moyenne du profil)
  23038. *********** cas LAMBDAQ FLU1 = FACFM1 * VFLUXIMPOSE ( =PHI0)
  23039. *********** cas LAMBDAQ VFPAT1 = exp*sinus*phi0
  23040. * SOM1 = somme de l'integrale de forme
  23041. * FACFM1 cette designation vient de FACTEUR de FORME 1
  23042. * ces valeurs proviennent de CFLUXX
  23043.  
  23044. SAUTER 1 LIGNE ;
  23045. MESS '---------------------------------------';
  23046. MESS ' Step number ' I_11 ' : Heat flux [MW/m2] ' ((EXTR TAB1.LIS_FLUX I_11)/1.E6);
  23047. MESS ' ' ;
  23048.  
  23049. * 'TRAC_GRAPHE' indice pour ne tracer les graphes qu'a l'iteration 1
  23050.  
  23051. SI (EGA I_11 1) ;
  23052. TAB1.'TRAC_GRAPHE' = VRAI ;
  23053. SINON ;
  23054. TAB1.'TRAC_GRAPHE' = FAUX ;
  23055. FINSI ;
  23056.  
  23057.  
  23058. FLU1 = EXTR TAB1.'LIS_FLUMOYEN' I_11;
  23059. PUI1 = EXTR TAB1.'LIS_PUI1' I_11;
  23060. TAB1.V_FLUMOY1 = EXTR TAB1.'LIS_FLUMOYEN' I_11;
  23061. *jsFLU1 = TAB1.'FLU1'.I_11;
  23062. *jsPUI1 = TAB1.'PUI1'.I_11;
  23063. *jsTAB1.V_FLUMOY1 = TAB1.'FLU1'.I_11;
  23064. VFPAT1 = TAB1.'VFPAT1'.I_11;
  23065. MESS '>@TPERM> LHEATED POWER' TAB1.L_HEATED PUI1;
  23066. @CALOR TAB1 PUI1 ;
  23067. *js 15/6/95T_LOCAL = TAB1.'T_LOCAL' ;
  23068. *
  23069. *--- CARACT. EAU A TMOY non a t_local
  23070. *
  23071. *--- AUTRE METHODE DE CALCUL DE H CONVECTION
  23072. *
  23073. SI ( NON ( EXISTE TAB1 PFIXTONB ) ) ;
  23074. TAB1 . PFIXTONB = FAUX ;
  23075. FINSI ;
  23076. *
  23077. *--- CALCUL DU COEFFICIENT D'ECHANGE
  23078. *
  23079. @CALHCON TAB1 ;
  23080. TAB1.'EV_FLUX_CONV'.I_11 = TAB1.EVOFT1 ;
  23081. *
  23082. *--- CALCUL DU FLUX CRITIQUE
  23083. *
  23084. @FLUCRIT TAB1 ;
  23085. TAB1.'FLUX_CRITIQUE'.I_11 = TAB1.L_QCHFW ;
  23086. *
  23087. *---- modif Jean BOSCARY 05 10 94
  23088. * faire apparaitre la vraie valeur de TONG75
  23089. * i.e. QCRI1 non multiplie par 1.67
  23090. SI ( NON ( EXISTE TAB1 M_TONGJB ) ) ;
  23091. TAB1.M_TONGJB = FAUX ;
  23092. FINSI ;
  23093. SI TAB1.M_TONGJB ;
  23094. QCRI2 HOU1 TOU1 DTSUB1 XOU1 = TONG75JB TAB1 ;
  23095. TAB1.'FLJB_CRI_TONG'.I_11 = QCRI2 ;
  23096. FINSI ;
  23097. *
  23098. *
  23099. *--- APPEL PROCEDURE CALCUL DE 'H RAYONNEMENT'
  23100. *
  23101. ERAYON1 = @CALHRAY TAB1 ;
  23102. TAB1.'EV_FLUX_RAYO'.I_11 = TAB1.EVORAYT1 ;
  23103. *
  23104. MESS ' MAXI MINI VALEURS CALCULEES DU FLUX RENTRANT ' ( MAXI VFPAT1 ) ( MINI VFPAT1 );
  23105. FPAT1 = FLUX (TAB1 . 'MODELF') VFPAT1 ;
  23106. @TRFLI VFPAT1 FPAT1 TAB1 ;
  23107. *--- INIT DES TABLES
  23108. *---(DONNEES A ENVOYER DANS PROCEDUR TRANSIT1)
  23109. *
  23110. SI ( EXISTE TAB1 TEMPERATURE ) ;
  23111. MENAGE ;
  23112. FINSI ;
  23113. SI ( TAB1.OLD ) ;
  23114. TAB1.'SOUSTYPE' = THERMIQUE ;
  23115. SI ( EXISTE TAB1 LFLUX_CONV ) ;
  23116. TAB1.'MAILLAGV' = TAB1.LFLUX_CONV ;
  23117. TAB1.'CONVECTION' = IPOL TAB1.'T_LOCAL' ( EXTR TAB1.ECONVEC1 'TEMPERATURE' ) ( EXTR TAB1.ECONVEC1 'CONVECTION' ) ;
  23118. TAB1.'EVOCONV' = TAB1.ECONVEC1 ;
  23119. FINSI ;
  23120. SI ( EXISTE TAB1 LFLUX_RAYO ) ;
  23121. TAB1.'MAILLAGR' = TAB1.LFLUX_RAYO ;
  23122. TAB1.'HRAYONNE' = IPOL (TAB1.TEMP_RAYO) ( EXTR ERAYON1 'TEMPERATURE' ) ( EXTR ERAYON1 'COEFFICIENT ECHANGE' ) ;
  23123. TAB1.'TETR' = TAB1.TEMP_RAYO ;
  23124. TAB1.'EVOCONR' = ERAYON1 ;
  23125. FINSI ;
  23126. FPAT2 = FPAT1 ;
  23127. SI ( EXISTE TAB1 V_SOURCE ) ;
  23128. FPAT2 = FPAT1 ET TAB1.'FSOU1' ;
  23129. FINSI ;
  23130. FPAT3 = FPAT2 ;
  23131. SI ( EXISTE TAB1 'FLUX_IMP' ) ;
  23132. FPAT3 = FPAT2 ET TAB1.'FLUX_IMP' ;
  23133. FINSI ;
  23134. TAB1.'FLUX' = FPAT3 ;
  23135.  
  23136. * TEMPS ;
  23137. *
  23138. *--- APPEL PROCED. TRANSIT1
  23139. *--- RESOL PB THERMIQUE NONLIN
  23140. *
  23141. TAB1.'TETA' = TAB1.'T_LOCAL';
  23142. @TRANS10 TAB1;
  23143. TAB1.I_11 = TAB1.TEMPERATURE;
  23144. TAB1.I_FPAT1.I_11 = FPAT1;
  23145. TAB1.RESUTHER.COEFECHANGE.I_11 = TAB1.COEFECHANGE;
  23146. TAB1.RESUTHER.VALEUR_TETA.I_11 = TAB1.VALEUR_TETA;
  23147. TAB1.RESUTHER.COEFRAYONNE.I_11 = TAB1.COEFRAYONNE;
  23148. TAB1.RESUTHER.CONDUCMAT.I_11 = TAB1.CONDUCMAT;
  23149. SINON;
  23150. TAB1.'SOUSTYPE' = THERMIQUE ;
  23151. SI( NON (EXISTE TAB1 TEMPERATURE) );
  23152. TAB1.'INSTANT(0)' = MANU CHPO STOT1 1 'T' TAB1.'T_LOCAL';
  23153. SINON;
  23154. TAB1.'INSTANT(0)' = TAB1.TEMPERATURE;
  23155. FINSI;
  23156. TAB1.CONVECTION = TABLE;
  23157. TAB1.CONVECTION.TABCONV1 = TABLE;
  23158. TAB1.CONVECTION.TABTE1 = TABLE;
  23159. MCONV1 = MODE TAB1.LFLUX_CONV CONVECTION;
  23160. MCONV2 = MODE TAB1.LFLUX_RAYO CONVECTION;
  23161. TAB1.CONVECTION.TABCONV1.MCONV1 = TAB1.ECONV ;
  23162. TAB1.CONVECTION.TABTE1.MCONV1 = TAB1.'T_LOCAL' ;
  23163. TAB1.CONVECTION.TABCONV1.MCONV2 = ERAYON1 ;
  23164. TAB1.CONVECTION.TABTE1.MCONV2 = TAB1.'TEMP_RAYO' ;
  23165. FPAT2 = FPAT1 ;
  23166. SI ( EXISTE TAB1 V_SOURCE ) ;
  23167. FPAT2 = FPAT1 ET TAB1.'FSOU1' ;
  23168. FINSI ;
  23169. TAB1.'FLUX' = FPAT2 ;
  23170. TEMPS;
  23171. TRANSIT1 TAB1;
  23172. TEMPS;
  23173. TAB1.RESUTHER.COEFECHANGE.I_11 = TAB1.COEFECHANGE.MCONV1 ;
  23174. TAB1.RESUTHER.VALEUR_TETA.I_11 = TAB1.CONVECTION.TABTE1.MCONV1;
  23175. * TAB1.RESUTHER.VALEUR_TETA.I_11 = TAB1.VALEUR_TETA.MCONV1 ;
  23176. TAB1.RESUTHER.COEFRAYONNE.I_11 = TAB1.COEFECHANGE.MCONV2;
  23177. TAB1.RESUTHER.CONDUCMAT.I_11 = TAB1.CONDUCMAT ;
  23178.  
  23179. FINSI;
  23180. FIN BOCA;
  23181. FINSI;
  23182. *
  23183. *
  23184. * FIN DU PERMANENT
  23185. *
  23186. FINPROC ;
  23187. *
  23188. *----------Fin de la procedure @TPERM
  23189. *--------------------------------------------------------------------
  23190.  
  23191. **** @TRASCH
  23192. DEBPROC @TRASCH M1/MOT OE1/POINT MO1*MMODEL CHA1*MCHAML MA1*MAILLAGE MA2*MAILLAGE CT1*MAILLAGE ;
  23193.  
  23194. *
  23195. * !!! R. MITTEAU !!! attention, procedure standard
  23196. *
  23197. * un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
  23198. * pour les mises a jour
  23199. *
  23200.  
  23201. CHA2 = REDU CHA1 MO1 ;
  23202. CH1 = CHAN CHPO MO1 CHA2 ;
  23203. * CH2 = CHAN 'ATTRIBUT' CH1 'NATURE' 'DISCRET' ;
  23204. CHA2 = REDU CHA1 MO1 ;
  23205. CO1 = EXTR (EXTR CH1 'COMP') 1 ;
  23206. V1 = ((MINI CH1) + (MAXI CH1)) * .5 ;
  23207. SI (EGA (NBEL MA1) (NBEL MA2));
  23208. CHT = CH1 ;
  23209. SINON ;
  23210. MAE = (CHAN POI1 MA1) DIFF (CHAN POI1 MA2) ;
  23211. CHE = MANU CHPO MAE 1 CO1 V1 ;
  23212. * CHE2 = CHAN 'ATTRIBUT' CHE 'NATURE' 'DISCRET' ;
  23213. CHT = @ET CH1 CHE ;
  23214. FINSI ;
  23215. SI (NON (EXISTE M1)) ;
  23216. M1 = TEXT ' ';
  23217. FINSI ;
  23218. SI (NON ( EXISTE OE1)) ;
  23219. OE1 = TEXT ' ' ;
  23220. FINSI ;
  23221. TRAC M1 OE1 CHT MA2 CT1 ;
  23222. FINPROC ;
  23223. **** @TRCPLAS
  23224. DEBPROC @TRCPLAS TAB1*TABLE MO_1*MMODEL I__1*ENTIER ;
  23225. MESS '---------------------------------> Entree dans @TRCPLAS ';
  23226. P_T1 = PROG 20. 100. 200. 300. 400. 500. 600. 700. 800. 900. ;
  23227. * P_T1 = PROG 20. 100. 200. 300. 400. 500. 600. ;
  23228. EPSB = 0.05 ;
  23229. I1_1 = 0 ;
  23230. TITRE TAB1.NOM_MAT.I__1 'CINEMATIC PLASTIFICATION CURVES' ;
  23231. T_AC1 = TABLE ;
  23232. LIS_1 = MOTS CROI TRIA PLUS LOSA CARR TRIB ETOI TRIB CARR LOSA;
  23233. REPETER BOCPLAS1 ( DIME P_T1 ) ;
  23234. I1_1 = I1_1 + 1 ;
  23235. T_1 = EXTRAIRE P_T1 I1_1 ;
  23236. EE_1 = @IPOE T_1 TAB1.'TETMAT'.MO_1.'YOUN' ;
  23237. YY_1 = @IPOE T_1 TAB1.'TETMAT'.MO_1.'SIGY' ;
  23238. HH_1 = @IPOE T_1 TAB1.'TETMAT'.MO_1.'H' ;
  23239. EPSY = YY_1 / EE_1 ;
  23240. S_B = YY_1 + ((EPSB - EPSY)* HH_1) ;
  23241. P_EPS1 = PROG 0. EPSY EPSB ;
  23242. P_SIG1 = PROG 0. YY_1 S_B ;
  23243. EV_1 = EVOL MANU '1EPSILON' P_EPS1 '1SIGMA' P_SIG1 ;
  23244. SI (EGA I1_1 1) ;
  23245. EV_PL1 = EV_1 ;
  23246. SINON ;
  23247. EV_PL1 = EV_PL1 ET EV_1 ;
  23248. FINSI ;
  23249. MARQ1 = EXTR I1_1 LIS_1 ;
  23250. T_AC1.I1_1 = 'CHAIN' ' MARQ ' MARQ1 ' TITR ' T_1 ;
  23251. FIN BOCPLAS1 ;
  23252. DESS EV_PL1 LEGE XBOR 0. 0.003 MIMA DATE T_AC1 ;
  23253. DESS EV_PL1 LEGE XBOR 0. 0.04 MIMA DATE T_AC1 ;
  23254. MESS '---------------------------------> Sortie de @TRCPLAS ';
  23255. FINPROC ;
  23256. **** @TRFLI
  23257. DEBPROC @TRFLI VFPAT1*CHPOINT FPAT1*CHPOINT TAB1*TABLE ;
  23258. *
  23259. ************************************************************************
  23260. * @TRFLI procedure de trace du flux incident 2D et 3D *
  23261. * VECFLUI vecteur representant le flux incident *
  23262. * VECFLUII vecteur representant le flux incident integre EF *
  23263. * Reecriture et rajout de la visu 3D : Alain MOAL (aout 1995) *
  23264. ************************************************************************
  23265. *
  23266. *------------------ VARIABLES D'ENTREE
  23267. COSDIR1 = TAB1.C_COTETF1 ;
  23268. COSDIR2 = TAB1.C_SITETF1 ;
  23269. COSDIR3 = TAB1.C_COS3F1 ;
  23270. IHYPVAP = TAB1.HYPERVAP ;
  23271. DH0 = TAB1.DH ;
  23272. MAXSOFL = TAB1.MAX_SOFL ;
  23273. DMAQ0 = TAB1.D_MAQUETTE ;
  23274. CONT0 = TAB1.'M_IL_CONTOUR' ;
  23275. ITRACFI = TAB1.L_TRAC_FLUXI ;
  23276. NIVEAU1 = TAB1.'NIVEAU' ;
  23277. SI (NIVEAU1 >EG 4) ;
  23278. MESS '-----------------------------------> calling @TRFLI ';
  23279. FINSI ;
  23280. SI (NIVEAU1 >EG 3) ;
  23281. MESS '> @TRFLI > IHYPVAP ';LIST IHYPVAP ;
  23282. MESS '> @TRFLI > DH0 ' DH0 ;
  23283. MESS '> @TRFLI > MAXSOFL ' MAXSOFL ;
  23284. MESS '> @TRFLI > DMAQ0 ' DMAQ0 ;
  23285. MESS '> @TRFLI > NIVEAU1 ' NIVEAU1 ;
  23286. TITR '> @TRFLI > CONT0' ; TRAC CONT0 NCLK ;
  23287. MESS '> @TRFLI > ITRACFI ';LIST ITRACFI ;
  23288. FINSI ;
  23289. SI (EGA (VALEUR DIME) 3) ;
  23290. LIG0 = TAB1.LFLUX_EXTE_DESS ;
  23291. OEIL0 = TAB1.VIEW_P ;
  23292. FINSI ;
  23293. *--------------------------------------
  23294. *
  23295. *---- facteurs d'amplification pour la visualisation des vecteurs
  23296.  
  23297. SI IHYPVAP ;
  23298. AMPLV1 = DH0 / (2. * MAXSOFL) ;
  23299. SINON ;
  23300. AMPLV1 = DMAQ0 / (2. * MAXSOFL) ;
  23301. FINSI ;
  23302. AMPLP1 = AMPLV1 * 1.E5 ;
  23303. *
  23304. *---- visualisations en 2D
  23305. *
  23306. SI (EGA (VALEUR DIME) 2) ;
  23307. * ---- CONT0 est une ligne
  23308. CHPX = EXCO SCAL (VFPAT1 * COSDIR1) UX ;
  23309. CHPY = EXCO SCAL (VFPAT1 * COSDIR2) UY ;
  23310. CHPT = @ET CHPX CHPY ;
  23311. VECFLUI = @VECADA CHPT (-1. * AMPLV1) 'ROUGE' ;
  23312. *
  23313. CHPX = EXCO Q (FPAT1 * COSDIR1) UX ;
  23314. CHPY = EXCO Q (FPAT1 * COSDIR2) UY ;
  23315. CHPT = @ET CHPX CHPY ;
  23316.  
  23317. VECFLUII = @VECADA CHPT (-1. * AMPLP1) 'ROUGE' ;
  23318. *
  23319. SI ITRACFI ;
  23320. TITRE ' @TRFLI : INCIDENT FLUX ' ;
  23321. TRAC VECFLUI CONT0 ;
  23322. TITRE ' @TRFLI : INTEGRATED FLUX ' ;
  23323. TRAC VECFLUII CONT0 ;
  23324. FINSI;
  23325. FINSI ;
  23326. *
  23327. *---- visualisations en 3D
  23328. *
  23329. SI (EGA (VALEUR DIME) 3) ;
  23330. * ---- CONT0 est une surface, LIG0 est une ligne
  23331. CHPX = EXCO SCAL (VFPAT1 * COSDIR1) UX ;
  23332. CHPY = EXCO SCAL (VFPAT1 * COSDIR2) UY ;
  23333. CHPZ = EXCO SCAL (VFPAT1 * COSDIR3) UZ ;
  23334. CHPT = @ET (@ET CHPX CHPY) CHPZ ;
  23335. VECFLUI = @VECADA CHPT (-1. * AMPLV1) 'ROUGE' ;
  23336. *
  23337. CHPX = EXCO Q (FPAT1 * COSDIR1) UX ;
  23338. CHPY = EXCO Q (FPAT1 * COSDIR2) UY ;
  23339. CHPZ = EXCO Q (FPAT1 * COSDIR3) UZ ;
  23340. CHPT = @ET (@ET CHPX CHPY) CHPZ ;
  23341. VECFLUII = @VECADA CHPT (-1. * AMPLP1) 'ROUGE' ;
  23342. *
  23343. SI ITRACFI ;
  23344. TITRE ' @TRFLI : INCIDENT FLUX ' ;
  23345. TRAC 'CACH' OEIL0 VECFLUI CONT0 ;
  23346. TITRE ' @TRFLI : INTEGRATED FLUX ' ;
  23347. TRAC 'CACH' OEIL0 VECFLUII CONT0 ;
  23348. FINSI;
  23349. *
  23350. * ---- Trace du flux incident le long d'une ligne
  23351. * ---- en fonction de l'abscisse curviligne
  23352. TITRE ' @TRFLI : INCIDENT FLUX' ;
  23353. FLUXI = NOMC SCAL VFPAT1 ;
  23354. DESSIN (EVOL JAUN CHPO FLUXI SCAL LIG0) MIMA ;
  23355. FINSI ;
  23356. *
  23357. *------------------ VARIABLES DE SORTIE
  23358. TAB1.V_VEC11 = VECFLUII ;
  23359. TAB1.V_VEC22 = VECFLUI ;
  23360. *--------------------------------------
  23361. *
  23362. SI (NIVEAU1 >EG 4) ;
  23363. MESS '-----------------------------------> exiting @TRFLI ';
  23364. FINSI ;
  23365. FINPROC ;
  23366.  
  23367. **** @TTRACG
  23368. debproc @ttracg poin1/point text1/texte text2/texte text3/texte geo1*maillage str1*maillage ;
  23369.  
  23370. v1 = vale dime ;
  23371.  
  23372. str2 = str1 coul blan ;
  23373. geo2 = geo1 coul roug ;
  23374.  
  23375. ld1 = (maxi (coor 1 geo1)) - (mini (coor 1 geo1)) ;
  23376. ld2 = (maxi (coor 2 geo1)) - (mini (coor 2 geo1)) ;
  23377. ld3 = (maxi (coor 3 geo1)) - (mini (coor 3 geo1)) ;
  23378.  
  23379. dcar1 = ((ld1 * ld1) + (ld2 * ld2) + (ld3 * ld3)) ** .5 ;
  23380. dcar2 = dcar1 / 10000. ;
  23381. dcar3 = dcar2 * (2.**.5) ;
  23382.  
  23383. * dcar1 est la dimension caracteristique de geo1
  23384.  
  23385.  
  23386. si (ega v1 2) ;
  23387. geo3 = geo2 plus (dcar2 dcar3) ;
  23388. sinon ;
  23389. geo3 = geo2 plus (dcar2 dcar3 0.);
  23390. finsi ;
  23391.  
  23392. *1texttit = chain geo1 'en rouge et ' geo2 'en blan' ;
  23393. *titr 1texttit
  23394.  
  23395.  
  23396. si (exis poin1) ;
  23397. poin2 = poin1;
  23398. sinon ;
  23399. poin2 = text ' ';
  23400. finsi ;
  23401.  
  23402. si (exis text3) ;
  23403. trac poin2 text1 text2 text3 (geo3 et str2) ;
  23404. sinon ;
  23405. si (exis text2 ) ;
  23406. trac poin2 text1 text2 (geo3 et str2);
  23407. sinon ;
  23408. si (exis text1 ) ;
  23409. trac poin2 text1 (geo3 et str2) ;
  23410. sinon ;
  23411. trac poin2 (str2 et geo3 );
  23412. finsi ;
  23413. finsi ;
  23414. finsi ;
  23415.  
  23416.  
  23417.  
  23418.  
  23419.  
  23420. finproc ;
  23421.  
  23422.  
  23423.  
  23424.  
  23425. **** @TTRACP
  23426. debproc @ttracp text1/text text2/text text3/text pp1*point geo1*maillage ;
  23427.  
  23428. v1 = vale dime ;
  23429.  
  23430. geo2 = geo1 coul bleu ;
  23431. ld1 = (maxi (coor 1 geo1)) - (mini (coor 1 geo1)) ;
  23432. ld2 = (maxi (coor 2 geo1)) - (mini (coor 2 geo1)) ;
  23433. ld3 = (maxi (coor 3 geo1)) - (mini (coor 3 geo1)) ;
  23434.  
  23435. dcar1 = ((ld1 * ld1) + (ld2 * ld2) + (ld3 * ld3)) ** .5 ;
  23436. dcar2 = dcar1 / 50. ;
  23437. dcar3 = -1. * dcar2 ;
  23438.  
  23439. * dcar1 est la dimension caracteristique de geo1
  23440.  
  23441.  
  23442. si (ega v1 2) ;
  23443. pp2 = pp1 plus (dcar2 dcar2);
  23444. pp3 = pp1 plus (dcar3 dcar3);
  23445. pp4 = pp1 plus (dcar2 dcar3);
  23446. pp5 = pp1 plus (dcar3 dcar2);
  23447. croix1 = (pp2 d 1 pp3) et (pp4 d 1 pp5);
  23448. sinon ;
  23449. pp2 = pp1 plus (dcar2 0. 0.);
  23450. pp3 = pp1 plus (dcar3 0. 0.);
  23451. pp4 = pp1 plus (0. dcar2 0.);
  23452. pp5 = pp1 plus (0. dcar3 0.);
  23453. pp6 = pp1 plus (0. 0. dcar2);
  23454. pp7 = pp1 plus (0. 0. dcar3);
  23455. croix1 = (pp2 d 1 pp3) et (pp4 d 1 pp5) et (pp6 d 1 pp7) ;
  23456. finsi ;
  23457.  
  23458. croix2 = croix1 coul roug ;
  23459.  
  23460.  
  23461. *1texttit = chain 'point ' pp1 'dans' geo1 ;
  23462. *titr 1texttit
  23463.  
  23464. si (exis text3) ;
  23465. trac text1 text2 text3 (geo2 et croix2) ;
  23466. sinon ;
  23467. si (exis text2 ) ;
  23468. trac text1 text2 (geo2 et croix2) ;
  23469. sinon ;
  23470. si (exis text1 ) ;
  23471. trac text1 (geo2 et croix2) ;
  23472. sinon ;
  23473. trac (geo2 et croix2) ;
  23474. finsi ;
  23475. finsi ;
  23476. finsi ;
  23477.  
  23478.  
  23479.  
  23480.  
  23481.  
  23482. finproc ;
  23483.  
  23484.  
  23485.  
  23486.  
  23487. **** @TTRANS
  23488. 'DEBPROC' @TTRANS TAB1*'TABLE ' ;
  23489. ** on regarde si il y a un transitoire
  23490. SI ( NON ( EXISTE TAB1 TRANSITOIRE )) ;
  23491. TAB1.TRANSITOIRE = FAUX ;
  23492. FINSI ;
  23493. *
  23494. SI ( TAB1.TRANSITOIRE ) ;
  23495. TAB1.ITER = DIME TAB1.LIS_FLUX;
  23496. TAB1.'TRAC_GRAPHE' = VRAI ;
  23497.  
  23498. *********** cas LAMBDAQ VPAT1 = exp*sinus
  23499. *********** cas LAMBDAQ SOM1 = somme ( exp*sinus)
  23500. *********** cas LAMBDAQ SOM3 = SOM1 * PHIZERO
  23501. *********** cas LAMBDAQ FACFM1 = SOM1 / largeur (v. moyenne du profil)
  23502. *********** cas LAMBDAQ FLU1 = FACFM1 * VFLUXIMPOSE
  23503. *********** cas LAMBDAQ VFPAT1 = exp*sinus*phi0
  23504. *********** cas LAMBDAQ FLU1 = FACFM1 * VFLUXIMPOSE
  23505. *********** cas LAMBDAQ PHIZERO = VFLUXIMPOSE
  23506.  
  23507. *js FLU1 = TAB1.'FLU1'.(DIME TAB1.LIS_FLUX);
  23508. *js PUI1 = TAB1.'PUI1'.(DIME TAB1.LIS_FLUX);
  23509. FLU1 = EXTR TAB1.'LIS_FLUMOYEN' 1;
  23510. PUI1 = EXTR TAB1.'LIS_PUI1' 1;
  23511.  
  23512. TAB1.V_FLUMOY1 = FLU1;
  23513.  
  23514. VFPAT1 = TAB1.'VFPAT1'.(DIME TAB1.LIS_FLUX);
  23515. FPAT1 = FLUX TAB1.'MODELF' VFPAT1;
  23516. * SOM2 = ( MAXI (RESU FPAT1)) ;
  23517. * MESS ' >>>>resu flux element finis ' SOM2 ;
  23518. * MESS ' >>>>valeur prevue ' TAB1.'V_SOM1';
  23519. * SI ( NON ( TAB1.'V_SOM1' EGA SOM2 ( ABS ( SOM2 * 0.05 ))) ) ;
  23520. * MESS ' >>>>verifiez vos valeurs, desole ' ;
  23521. * ERREUR 'VALEUR_DU_FLUX_RENTRANT' ;
  23522. * FINSI ;
  23523. @CALOR TAB1 PUI1 ;
  23524. TIN = TAB1 . T_IN ;
  23525. * CPF = @IPOE TIN TAB1.ETCPF ;
  23526. * EMDOTI = TAB1.V_EMDOTI ;
  23527. * TOUT = TIN + (PUI1 / (EMDOTI * CPF)) ;
  23528. * TAB1.'T_LOCAL' = TIN + ((TOUT - TIN ) * TAB1.X_LOCAL) ;
  23529. * TMOY = (TIN + TOUT) / 2. ;
  23530. * TMOY= TAB1.'T_MOY' ;
  23531.  
  23532.  
  23533. *
  23534. *--- APPEL PROCEDURE CALCUL DE 'H CONVECTION (TRANS)'
  23535. *
  23536. SI ( EXISTE TAB1 PFIXTONB ) ;
  23537. TAB1 . PFIXTONB = VRAI ;
  23538. SINON ;
  23539. TAB1 . PFIXTONB = FAUX ;
  23540. FINSI ;
  23541.  
  23542. SI ( NON ( EXISTE TAB1 TETA )) ;
  23543. TAB1.'TETA' = TAB1.'T_LOCAL';
  23544. * TAB1 . 'TETA' = TIN ;
  23545. * MESS '>@TTRANS> Initial Temperature set to TIN';
  23546. FINSI ;
  23547. *
  23548. *SI( NON (EXISTE TAB1 NO_CONV)) ;
  23549. @FLUCRIT TAB1 ;
  23550. * RM 13.03.1997
  23551. SI (TAB1.COUPE_ECH_A_CHF) ;
  23552. TAB1.FLUCRIT1 = TAB1.CHF;
  23553. FINSI ;
  23554. @CALHCON TAB1 ;
  23555. TAB1.'CONVECTION' = TABLE ;
  23556. TAB1.'CONVECTION' . 'MAILLAGE' = TAB1 . LFLUX_CONV ;
  23557. TAB1.'CONVECTION' . 'EVOCONV' = EVOL MANU 'TEMPERATURE' ( EXTR TAB1.ECONVEC1 'ABSC' ) 'COEFFICIENT ECHANGE' ( EXTR TAB1.ECONVEC1 'ORDO' ) ;
  23558. TAB1.'CONVECTION' . 'TEMP_EXT' = TAB1.'TETA' ;
  23559. *FINSI ;
  23560.  
  23561.  
  23562. *
  23563. *
  23564. *--- APPEL PROCEDURE CALCUL DE 'H RAYONNEMENT'
  23565. *
  23566. *
  23567. ERAYON1 = @CALHRAY TAB1 ;
  23568. *
  23569.  
  23570. MOT1 = ' TRANSITOIRE NONLINEAIRE METHODE DUPONT2 ' ;
  23571. TAB1.'SOUSTYPE' = THERMIQUE ;
  23572.  
  23573.  
  23574. S_TOT1 = TAB1.'M_ILLAGE_TOT' ;
  23575. SI ( NON ( EXISTE TAB1 'INITIAL(0)')) ;
  23576. TAB1.'INITIAL(0)' = MANU CHPO S_TOT1 1 'T' TAB1.'TETA' ;
  23577. TAB1.'INITIAL(1)' = MANU CHPO S_TOT1 1 'T' TAB1.'TETA' ;
  23578. SINON ;
  23579. SI ( NON ( EXISTE TAB1 'INITIAL(1)')) ;
  23580. TAB1.'INITIAL(1)' = TAB1.'INITIAL(0)' ;
  23581. FINSI ;
  23582. FINSI ;
  23583. TAB1.'RAYONNEMEN' = TABLE ;
  23584. TAB1.'RAYONNEMEN' . 'MAILLAGE' = TAB1 . LFLUX_RAYO ;
  23585. TAB1.'RAYONNEMEN' . 'EVORAYO' = ERAYON1 ;
  23586. TAB1.'RAYONNEMEN' . 'TEMP_EXT' = TAB1 . TEMP_RAYO ;
  23587. FPAT2 = FPAT1 ;
  23588. SI ( EXISTE TAB1 V_SOURCE ) ;
  23589. FPAT2 = FPAT1 ET TAB1.FSOU1 ;
  23590. FINSI ;
  23591. FPAT3 = FPAT2 ;
  23592. SI ( EXISTE TAB1 FLUX_IMP ) ;
  23593. FPAT3 = FPAT2 ET TAB1.FLUX_IMP ;
  23594. FINSI ;
  23595. TAB1.'FLUX' = CHAR 'Q' FPAT3 ( EVOL MANU 'TEMPS' ( TAB1.'PTF1') (TAB1.'PCF1') ) ;
  23596. * RM 11.03.97
  23597. @TRANSI3 TAB1 ;
  23598. * TEMPS ;
  23599.  
  23600. FINSI ;
  23601. FINPROC ;
  23602. *
  23603. *----------Fin de la procedure @TTRANS
  23604. *--------------------------------------------------------------------
  23605.  
  23606. **** @CVECT
  23607. DEBPROC @CVECT XV*CHPOINT YV*CHPOINT ZV*CHPOINT MAIL0*MAILLAGE COUL0*MOT AMPLI0/FLOTTANT;
  23608. *
  23609. **************************************************************
  23610. * Procedure de creation d'un objet de type vecteur a partir *
  23611. * des composantes d'un champ de vecteurs. *
  23612. * Si le facteur d'amplification pour visualiser un champ de *
  23613. * vecteur sur une geometrie n'est pas donne,il est adapte *
  23614. * aux dimensions geometriques du probleme. *
  23615. * Alain MOAL (juillet 1995) *
  23616. **************************************************************
  23617. *
  23618. XM = COOR 1 MAIL0 ;
  23619. YM = COOR 2 MAIL0 ;
  23620. SI ((VALEUR DIME) EGA 2) ;
  23621. ZM = XM * 0. ;
  23622. SINON ;
  23623. ZM = COOR 3 MAIL0 ;
  23624. FINSI ;
  23625. *
  23626. SI (NON (EXISTE AMPLI0)) ;
  23627. * ---- norme du vecteur
  23628. VECNORM = ((XV * XV) + (YV * YV) + (ZV * ZV))**0.5 ;
  23629. *
  23630. * ---- calcul d'une longueur caracteristique du maillage
  23631. LONGCAR1 = ABS ((MAXI XM) - (MINI XM)) ;
  23632. LONGCAR2 = ABS ((MAXI YM) - (MINI YM)) ;
  23633. LONGCAR3 = ABS ((MAXI ZM) - (MINI ZM)) ;
  23634. *
  23635. SI ((VALEUR DIME) EGA 2) ;
  23636. LONGCAR = MINI (PROG LONGCAR1 LONGCAR2) ;
  23637. SINON ;
  23638. LONGCAR = MINI (PROG LONGCAR1 LONGCAR2 LONGCAR3) ;
  23639. FINSI ;
  23640. *
  23641. AMPLI0 = LONGCAR / (MAXI VECNORM) / 3.;
  23642. *AM* AMPLI0 = LONGCAR / (MAXI VECNORM) ;
  23643. *AM* AMPLI0 = 2. * LONGCAR / (MAXI VECNORM) ;
  23644. FINSI ;
  23645. *
  23646. SI ((VALEUR DIME) EGA 2) ;
  23647. CHV1 = @ET (NOMC UX XV) (NOMC UY YV) ;
  23648.  
  23649.  
  23650. *CAST94* CHV1 = (NOMC UX XV) ET (NOMC UY YV) ;
  23651. VECT1 = VECT CHV1 AMPLI0 UX UY COUL0 ;
  23652. SINON ;
  23653. CHV1 = @ET (@ET (NOMC UX XV) (NOMC UY YV)) (NOMC UZ ZV) ;
  23654. *CAST94* CHV1 = (NOMC UX XV) ET (NOMC UY YV) ET (NOMC UZ ZV) ;
  23655. VECT1 = VECT CHV1 AMPLI0 UX UY UZ COUL0 ;
  23656. FINSI ;
  23657. FINPROC VECT1 ;
  23658.  
  23659.  
  23660. DEBPROC @VISRES TAB1*TABLE ;
  23661. *
  23662. ******************************************************************
  23663. * Procedure de visualisation des resultats d'un calcul permanent *
  23664. * en 3D. Alain MOAL (aout-sept 1995) *
  23665. ******************************************************************
  23666. *
  23667. MESS '---------------------------------> calling @VISRES';
  23668. *
  23669. ITER = 1 ;
  23670. *--------------- VARIABLES D'ENTREE :
  23671. MAIL0 = TAB1.<MAILLAGE ;
  23672. TEMP = TAB1.TEMPERATURE ;
  23673. LIGCONV = TAB1.LFLUX_CONV_DESS ;
  23674. SURFCONV = TAB1.LFLUX_CONV ;
  23675. SURFEXTE = TAB1.LFLUX_EXTE ;
  23676. TE1 = TAB1.ITER ;
  23677. VTETA1 = TAB1.RESUTHER.'VALEUR_TETA'.ITER ;
  23678. HCONV1 = TAB1.RESUTHER.COEFECHANGE.ITER ;
  23679. PROFIL0 = TAB1.V_VPAT1 ;
  23680. FLU0 = EXTR TAB1.LIS_FLUX ITER;
  23681. MODEL0 = TAB1.MODELF ;
  23682. LIG0 = TAB1.LFLUX_EXTE_DESS ;
  23683. MAXSOFL = TAB1.MAX_SOFL ;
  23684. DMAQ0 = TAB1.D_MAQUETTE ;
  23685. NX = TAB1.C_COTETF1 ;
  23686. NY = TAB1.C_SITETF1 ;
  23687. NZ = TAB1.C_COS3F1 ;
  23688. VOLMAT1 = TAB1.ZONE_MAT.1 ;
  23689. VOLMAT2 = TAB1.ZONE_MAT.2 ;
  23690. VOLMAT3 = TAB1.ZONE_MAT.3 ;
  23691. ANGINCI = TAB1.<ANGINCI;
  23692. *TEST*VBVN = TAB1.<VBVN ;
  23693. SI ((DIME TAB1.<POINT_COUPE) EGA 3) ;
  23694. P1 = TEXT (EXTR TAB1.<POINT_COUPE 1) ;
  23695. P2 = TEXT (EXTR TAB1.<POINT_COUPE 2) ;
  23696. P3 = TEXT (EXTR TAB1.<POINT_COUPE 3) ;
  23697. SINON ;
  23698. ERRE '>>>> @VISRES : check TAB1.<POINT_COUPE' ;
  23699. FINSI ;
  23700. SI ((VALEUR DIME) EGA 3) ;
  23701. OEIL0 = TAB1.VIEW_P ;
  23702. SINON ;
  23703. ERRE '>>>> @VISRES only works on 3D geometries' ;
  23704. FINSI ;
  23705. *------------------------------------
  23706. *
  23707. *---- Table de visualisation
  23708. TAB2 = TABLE ;
  23709. TAB2.1 = 'MARQ CROI REGU MOT TITR FLUX' ;
  23710. TAB2.2 = 'MARQ TRIA REGU MOT TITR TEMPERATURE' ;
  23711. *
  23712. SI ((VALEUR DIME) NEG 3) ;
  23713. ERRE '>>>> @VISRES only works on 3D modelisations';
  23714. FINSI ;
  23715. *
  23716. FLU1 = FLU0 * PROFIL0 ;
  23717. *
  23718. *---- Trace du flux incident, de la temperature et de l'angle d'incidence
  23719. *---- le long d'une ligne en fonction de l'abscisse curviligne
  23720. XM = COOR 1 LIG0 ;
  23721. LIG2 = CHAN SEG2 LIG0 ;
  23722. XCUR = EXTR (EVOL CHPO XM SCAL (INVE LIG0)) ABSC ;
  23723. CHXCUR = MANU CHPO (INVE LIG2) 1 SCAL XCUR ;
  23724. FLUXI = NOMC SCAL FLU1 ;
  23725. TEMP1 = NOMC SCAL TEMP ;
  23726. TITRE ' @VISRES : INCIDENT FLUX (W/m2) AND TEMPERATURE (1.E-4*C)';
  23727. EVFLUI = EVOL JAUN CHPO FLUXI SCAL LIG0 ;
  23728. EVTEMI = EVOL ROUG CHPO (TEMP1*1.E4) SCAL LIG0 ;
  23729. DESSIN (EVFLUI ET EVTEMI) MIMA LEGE TAB2 ;
  23730. TITRE ' @VISRES : ANGLE BETWEEN B AND N (degree)';
  23731. EVANGI = EVOL JAUN CHPO ANGINCI SCAL LIG0 ;
  23732. DESSIN EVANGI MIMA ;
  23733. *TEST*TITRE ' @VISRES : VBVN ';
  23734. *TEST*EVVBVN = EVOL JAUN CHPO VBVN SCAL LIG0 ;
  23735. *TEST*DESSIN EVVBVN MIMA ;
  23736. *
  23737. *---- Trace de l'evolution du flux de convection le long d'une ligne
  23738. VTETA0 = REDU (EXCO 'T' TE1) LIGCONV ;
  23739. SI (EGA (TYPE VTETA1) 'CHPOINT ');
  23740. VTETA = EXCO 'T' VTETA1 ;
  23741. SINON ;
  23742. VTETA = VTETA1 ;
  23743. FINSI ;
  23744. HCONV = EXCO 'H' HCONV1 ;
  23745. *
  23746. *---- flux de convection sur la ligne et temperatures sur la ligne
  23747. FLUCONV = HCONV * (VTETA0 - VTETA) ;
  23748. TITRE '@VISRES : WALL FLUX (W/m2) AND WALL TEMPERATURE (1.E-5*C)' ;
  23749. EVFLUC = EVOL VERT CHPO FLUCONV SCAL LIGCONV ;
  23750. EVTEMC = EVOL TURQ CHPO (TEMP1*1.E5) SCAL LIGCONV ;
  23751. DESSIN (EVFLUC ET EVTEMC) MIMA LEGE TAB2 ;
  23752. *
  23753. *---- temperatures sur la ligne
  23754. *TITRE '@VISRES : WALL TEMPERATURE (C)' ;
  23755. *DESSIN (EVOL TURQ CHPO TEMP1 SCAL LIGCONV) MIMA ;
  23756. *
  23757. *---- flux de convection sur la surface de convection
  23758. FLUCONV0 = HCONV * (TE1 - VTETA) ;
  23759. *
  23760. *---- Calcul du facteur de concentration et de la puissance extraite
  23761. FACT0 = (MAXI FLUCONV0) / (MAXI FLU1);
  23762. FLUINT1 = FLUX MODEL0 FLU1 ;
  23763. FLUMOY = (MAXI(RESU FLUINT1)) / (MESU SURFEXTE) ;
  23764. PUI1 = MAXI(RESU FLUINT1) ;
  23765. *
  23766. *---- Trace en coupe des isovaleurs de temperature et des vecteurs flux
  23767. *---- incident et de convection
  23768. CHPX = EXCO SCAL (FLU1 * NX) UX ;
  23769. CHPY = EXCO SCAL (FLU1 * NY) UY ;
  23770. CHPZ = EXCO SCAL (FLU1 * NZ) UZ ;
  23771. CHPT = @ET (@ET CHPX CHPY) CHPZ ;
  23772. AMPLV1 = 10. * DMAQ0 / (2. * MAXSOFL) ;
  23773. VECFLUI = @VECADA CHPT (-1. * AMPLV1) 'ROUGE' ;
  23774. *FX = FLU1 * NX;
  23775. *FY = FLU1 * NY;
  23776. *FZ = FLU1 * NZ;
  23777. *VECFLUI = @CVECT FX FY FZ SURFEXTE VERT ;
  23778. TITRE '@VISRES : ISOTHERM IN SECTION' ;
  23779. TRAC OEIL0 COUPE P1 P2 P3 TEMP MAIL0;
  23780. *
  23781. *---- Trace des isovaleurs de temperature sans le maillage
  23782. TITRE '@VISRES : ISOTHERM, CONVECTED POWER 'PUI1' W';
  23783. SI (EGA (VALEUR ELEM) 'CUB8') ;
  23784. ARET1 = ARETE VOLMAT1 ;
  23785. ARET2 = ARETE VOLMAT2 ;
  23786. ARET3 = ARETE VOLMAT3 ;
  23787. SINON ;
  23788. ARET1 = ARETE VOLMAT1 40.;
  23789. ARET2 = ARETE VOLMAT2 40.;
  23790. ARET3 = ARETE VOLMAT3 40.;
  23791. FINSI ;
  23792. ARET0 = ARET1 ET ARET2 ET ARET3 ;
  23793. TRAC 7 CACH OEIL0 TEMP MAIL0 ARET0 ;
  23794. TRAC CACH OEIL0 TEMP MAIL0 ARET0 ;
  23795. *
  23796. *---- Messages
  23797. MESS ' HIGHEST WALL TEMPERATURE (C)..........: ' (MAXI VTETA0);
  23798. MESS ' LOWEST WALL TEMPERATURE (C)...........: ' (MINI VTETA0);
  23799. MESS ' MEAN INCIDENT FLUX (W/m2).............: ' FLUMOY ;
  23800. MESS ' HIGHEST INCIDENT FLUX (W/m2)..........: ' (MAXI FLU1) ;
  23801. MESS ' LOWEST INCIDENT FLUX (W/m2)...........: ' (MINI FLU1) ;
  23802. MESS ' HIGHEST CONVECTION FLUX (W/m2)........: ' (MAXI FLUCONV0);
  23803. MESS ' LOWEST CONVECTION FLUX (W/m2).........: ' (MINI FLUCONV0);
  23804. MESS ' CONCENTRATION FACTOR .................: ' FACT0 ;
  23805. *
  23806. MESS '---------------------------------> exiting @VISRES';
  23807. FINPROC ;
  23808. **** @VDEFAUT
  23809. DEBPROC @VDEFAUT TAB1*TABLE ;
  23810. *
  23811. **********************************************************************
  23812. * Procedure de preparation de la table TAB1 pour le calcul du profil *
  23813. * du depot de puissance par la procedure @TOKAFLU. *
  23814. * On donne ici les valeurs par defaut et on verifie l'existence de *
  23815. * certains indices importants de la table. Alain MOAL (juillet 1995) *
  23816. **********************************************************************
  23817. *
  23818. MESS '---------------------------------> calling @VDEFAUT ';
  23819. SI (NON (EXISTE TAB1 <IMESS)) ;
  23820. TAB1.<IMESS = 1 ;
  23821. MESS 'The level of message on screen is : 1';
  23822. FINSI;
  23823. SI (NON (EXISTE TAB1 <ITRAC)) ;
  23824. TAB1.<ITRAC = VRAI ;
  23825. MESS 'Drawings are printed on screen';
  23826. FINSI;
  23827. SI (NON (EXISTE TAB1 <COEFA)) ;
  23828. TAB1.<COEFA = 5.8E-5 ;
  23829. MESS 'The first coefficient of the ripple model is : 5.8E-5';
  23830. FINSI;
  23831. SI (NON (EXISTE TAB1 <COEFB)) ;
  23832. TAB1.<COEFB = 5.5 ;
  23833. MESS 'The second coefficient of the ripple model is : 5.5';
  23834. FINSI;
  23835. SI (NON (EXISTE TAB1 <COEFC)) ;
  23836. TAB1.<COEFC = 4.5E-5 ;
  23837. MESS 'The third coefficient of the ripple model is : 4.5E-5';
  23838. FINSI;
  23839. SI (NON (EXISTE TAB1 <EPS)) ;
  23840. TAB1.<EPS = 1.E-5 ;
  23841. MESS 'The convergence criterium is : 1.E-5';
  23842. FINSI;
  23843. SI (NON (EXISTE TAB1 <RR)) ;
  23844. TAB1.<RR = 2.20 ;
  23845. MESS 'The large radius of the ripple referential is : 2.20 m';
  23846. FINSI;
  23847. SI (NON (EXISTE TAB1 <RP)) ;
  23848. MESS 'You must give the value of the large plasma radius';
  23849. ERRE '>>>> TAB1.<RP is missing' ;
  23850. FINSI;
  23851. SI (NON (EXISTE TAB1 <HP)) ;
  23852. TAB1.<HP = 0. ;
  23853. MESS 'The height of the plasma center is : 0. m';
  23854. FINSI;
  23855. SI (NON (EXISTE TAB1 <IPLASMA)) ;
  23856. MESS 'You must give the value of the plasma current' ;
  23857. ERRE '>>>> TAB1.<IPLASMA is missing ' ;
  23858. FINSI;
  23859. SI (NON (EXISTE TAB1 <INTENS)) ;
  23860. MESS 'You must give the value of the current in each whorl';
  23861. MESS 'of coils';
  23862. ERRE '>>>> TAB1.<INTENS is missing ' ;
  23863. FINSI;
  23864. SI (NON (EXISTE TAB1 <LAMB)) ;
  23865. MESS 'You must give the value of the asymmetrical factor ';
  23866. MESS 'of the poloidal field';
  23867. ERRE '>>>> TAB1.<LAMB is missing ' ;
  23868. FINSI;
  23869. SI (NON (EXISTE TAB1 <THETA0)) ;
  23870. TAB1.<THETA0 = 0. ;
  23871. *AM*MESS 'The THETA angle locating the part into the tokamak is : 0.';
  23872. FINSI;
  23873. *
  23874. * RM attention, ce <ANGPHI0 n a rien a voir avec <ANG_PHI0
  23875. *
  23876. SI (NON (EXISTE TAB1 <ANGPHI0)) ;
  23877. TAB1.<ANGPHI0 = 0. ;
  23878. FINSI;
  23879. SI (NON (EXISTE TAB1 <THETAREF)) ;
  23880. TAB1.<THETAREF = -90. ;
  23881. MESS 'The reference angle for lambdaq is : -90. degrees';
  23882. FINSI;
  23883. SI (NON (EXISTE TAB1 <LAMBQREF)) ;
  23884. *AM* TAB1.<LAMBQREF = 15.4 /((TAB1.<IPLASMA)**0.5) ;
  23885. MESS 'You must give the value of the reference decrease length ';
  23886. ERRE '>>>> TAB1.<LAMBQREF is missing ' ;
  23887. FINSI;
  23888. SI (NON (EXISTE TAB1 <TYPE_CALCUL)) ;
  23889. TAB1.<TYPE_CALCUL = MOT 'AVEC_SHIFT_AVEC_RIPPLE' ;
  23890. MESS 'The option of computation is : AVEC_SHIFT_AVEC_RIPPLE';
  23891. FINSI;
  23892. SI (NON (EXISTE TAB1 <MODEL_CHAMP)) ;
  23893. TAB1.<MODEL_CHAMP = MOT 'SHAFRANOV' ;
  23894. MESS 'The poloidal magnetic field model is : SHAFRANOV';
  23895. FINSI;
  23896. SI (NON (EXISTE TAB1 <NBOB)) ;
  23897. TAB1.<NBOB = 18 ;
  23898. MESS 'The number of coils is : 18 ';
  23899. FINSI;
  23900. SI (NON (EXISTE TAB1 <NSPI)) ;
  23901. TAB1.<NSPI = 2028 ;
  23902. MESS 'The number of whorls in each coil is : 2028 ';
  23903. FINSI;
  23904.  
  23905. SI ((VALEUR DIME) EGA 2) ;
  23906. SI (NON (EXISTE TAB1 <PLAN)) ;
  23907. MESS 'You must give the kind of 2D section ';
  23908. ERRE '>>>> TAB1.<PLAN is missing ' ;
  23909. FINSI ;
  23910. SI (EGA TAB1.<PLAN 'THECONS') ;
  23911. SI (NON (EXISTE TAB1 <THETA0)) ;
  23912. MESS 'You must give the THETA angle locating';
  23913. MESS 'the part into the tokamak' ;
  23914. ERRE '>>>> TAB1.<THETA0 is missing ' ;
  23915. FINSI ;
  23916. SI (NON (EXISTE TAB1 CENTRE_PLASMA)) ;
  23917. MESS 'You must give the plasma center ';
  23918. ERRE '>>>> TAB1.CENTRE_PLASMA is missing';
  23919. FINSI ;
  23920. FINSI ;
  23921. SI (EGA TAB1.<PLAN 'PHICONS') ;
  23922. SI (NON (EXISTE TAB1 <CENTRE_TORE)) ;
  23923. MESS 'You must give the tokamak center' ;
  23924. ERRE '>>>> TAB1.<CENTRE_TORE is missing' ;
  23925. FINSI ;
  23926. SI (NON (EXISTE TAB1 <POINT_SUR_AXE_TORE)) ;
  23927. MESS 'You must give a second point on the tokamak axis';
  23928. ERRE '>>>> TAB1.<POINT_SUR_AXE_TORE is missing';
  23929. FINSI ;
  23930. SI (NON (EXISTE TAB1 <POINT_SUR_OBJET)) ;
  23931. MESS 'You must give a reference point on the part';
  23932. ERRE '>>>> TAB1.<POINT_SUR_OBJET is missing';
  23933. FINSI ;
  23934. FINSI ;
  23935. SI (NON (EXISTE TAB1 LFLUX_EXTE_DESS)) ;
  23936. TAB1.LFLUX_EXTE_DESS = TAB1.LFLUX_EXTE ;
  23937. FINSI ;
  23938. FINSI;
  23939.  
  23940. SI ((VALEUR DIME) EGA 3);
  23941. SI (NON (EXISTE TAB1 <CENTRE_TORE)) ;
  23942. MESS 'You must give the tokamak center' ;
  23943. ERRE '>>>> TAB1.<CENTRE_TORE is missing' ;
  23944. FINSI ;
  23945. SI (NON (EXISTE TAB1 <POINT_SUR_AXE_TORE)) ;
  23946. MESS 'You must give a second point on the tokamak axis';
  23947. ERRE '>>>> TAB1.<POINT_SUR_AXE_TORE is missing';
  23948. FINSI ;
  23949. SI (NON (EXISTE TAB1 <POINT_SUR_OBJET)) ;
  23950. MESS 'You must give a reference point on the part';
  23951. ERRE '>>>> TAB1.<POINT_SUR_OBJET is missing';
  23952. FINSI ;
  23953. FINSI ;
  23954.  
  23955. SI (NON (EXISTE TAB1 <ANG_PHI0)) ;
  23956. MESS 'You must give the initial toroidal angle ';
  23957. MESS 'locating the reference point of the part ';
  23958. MESS 'in the tokamak';
  23959. ERRE '>>>> TAB1.<ANG_PHI0 is missing' ;
  23960. FINSI ;
  23961. SI ((VALEUR DIME) EGA 3) ;
  23962. SI (NON (EXISTE TAB1 VIEW_P)) ;
  23963. TAB1.VIEW_P = -1000. 1000. 1000. ;
  23964. FINSI;
  23965. FINSI;
  23966. *
  23967. *---- norme du champ magnetique toroidal au centre du plasma
  23968. * rm 24.07.97 BTOR0 = 2.E-7 * TAB1.<NBOB * TAB1.<NSPI * TAB1.<INTENS / TAB1.<RP
  23969. ;
  23970. BTOR0 = -2.E-7 * TAB1.<NBOB * TAB1.<NSPI * TAB1.<INTENS / TAB1.<RP ;
  23971. MESS 'The toroidal magnetic field at the plasma center is (T): 'BTOR0;
  23972. *
  23973. MESS '---------------------------------> exiting @VDEFAUT ';
  23974. FINPROC ;
  23975.  
  23976. **** @VDEFAUT
  23977. DEBPROC @VDEFAUT TAB1*TABLE ;
  23978. *
  23979. **********************************************************************
  23980. * Procedure de preparation de la table TAB1 pour le calcul du profil *
  23981. * du depot de puissance par la procedure @TOKAFLU. *
  23982. * On donne ici les valeurs par defaut et on verifie l'existence de *
  23983. * certains indices importants de la table. Alain MOAL (juillet 1995) *
  23984. **********************************************************************
  23985. *
  23986. MESS '---------------------------------> calling @VDEFAUT ';
  23987. SI (NON (EXISTE TAB1 <IMESS)) ;
  23988. TAB1.<IMESS = 1 ;
  23989. MESS 'The level of message on screen is : 1';
  23990. FINSI;
  23991. SI (NON (EXISTE TAB1 <ITRAC)) ;
  23992. TAB1.<ITRAC = VRAI ;
  23993. MESS 'Drawings are printed on screen';
  23994. FINSI;
  23995. SI (NON (EXISTE TAB1 <COEFA)) ;
  23996. TAB1.<COEFA = 5.8E-5 ;
  23997. MESS 'The first coefficient of the ripple model is : 5.8E-5';
  23998. FINSI;
  23999. SI (NON (EXISTE TAB1 <COEFB)) ;
  24000. TAB1.<COEFB = 5.5 ;
  24001. MESS 'The second coefficient of the ripple model is : 5.5';
  24002. FINSI;
  24003. SI (NON (EXISTE TAB1 <COEFC)) ;
  24004. TAB1.<COEFC = 4.5E-5 ;
  24005. MESS 'The third coefficient of the ripple model is : 4.5E-5';
  24006. FINSI;
  24007. SI (NON (EXISTE TAB1 <EPS)) ;
  24008. TAB1.<EPS = 1.E-5 ;
  24009. MESS 'The convergence criterium is : 1.E-5';
  24010. FINSI;
  24011. SI (NON (EXISTE TAB1 <RR)) ;
  24012. TAB1.<RR = 2.20 ;
  24013. MESS 'The large radius of the ripple referential is : 2.20 m';
  24014. FINSI;
  24015. SI (NON (EXISTE TAB1 <RP)) ;
  24016. MESS 'You must give the value of the large plasma radius';
  24017. ERRE '>>>> TAB1.<RP is missing' ;
  24018. FINSI;
  24019. SI (NON (EXISTE TAB1 <HP)) ;
  24020. TAB1.<HP = 0. ;
  24021. MESS 'The height of the plasma center is : 0. m';
  24022. FINSI;
  24023. SI (NON (EXISTE TAB1 <IPLASMA)) ;
  24024. MESS 'You must give the value of the plasma current' ;
  24025. ERRE '>>>> TAB1.<IPLASMA is missing ' ;
  24026. FINSI;
  24027. SI (NON (EXISTE TAB1 <INTENS)) ;
  24028. MESS 'You must give the value of the current in each whorl';
  24029. MESS 'of coils';
  24030. ERRE '>>>> TAB1.<INTENS is missing ' ;
  24031. FINSI;
  24032. SI (NON (EXISTE TAB1 <LAMB)) ;
  24033. MESS 'You must give the value of the asymmetrical factor ';
  24034. MESS 'of the poloidal field';
  24035. ERRE '>>>> TAB1.<LAMB is missing ' ;
  24036. FINSI;
  24037. SI (NON (EXISTE TAB1 <THETA0)) ;
  24038. TAB1.<THETA0 = 0. ;
  24039. *AM*MESS 'The THETA angle locating the part into the tokamak is : 0.';
  24040. FINSI;
  24041. *
  24042. * RM attention, ce <ANGPHI0 n a rien a voir avec <ANG_PHI0
  24043. *
  24044. SI (NON (EXISTE TAB1 <ANGPHI0)) ;
  24045. TAB1.<ANGPHI0 = 0. ;
  24046. FINSI;
  24047. SI (NON (EXISTE TAB1 <THETAREF)) ;
  24048. TAB1.<THETAREF = -90. ;
  24049. MESS 'The reference angle for lambdaq is : -90. degrees';
  24050. FINSI;
  24051. SI (NON (EXISTE TAB1 <LAMBQREF)) ;
  24052. *AM* TAB1.<LAMBQREF = 15.4 /((TAB1.<IPLASMA)**0.5) ;
  24053. MESS 'You must give the value of the reference decrease length ';
  24054. ERRE '>>>> TAB1.<LAMBQREF is missing ' ;
  24055. FINSI;
  24056. SI (NON (EXISTE TAB1 <TYPE_CALCUL)) ;
  24057. TAB1.<TYPE_CALCUL = MOT 'AVEC_SHIFT_AVEC_RIPPLE' ;
  24058. MESS 'The option of computation is : AVEC_SHIFT_AVEC_RIPPLE';
  24059. FINSI;
  24060. SI (NON (EXISTE TAB1 <TYPE_DEPOT)) ;
  24061. TAB1.<TYPE_DEPOT = MOT 'PARALLELE' ;
  24062. MESS 'The heat deposition is : PARALLELE';
  24063. FINSI;
  24064. * RM le 08/12/1998
  24065. SI (NON ((EGA TAB1.<TYPE_DEPOT 'PARALLELE') OU (EGA TAB1.<TYPE_DEPOT 'PERPENDICULAIRE')));
  24066. ERRE '>>>>@VDEFAUT, DEFINTION OF TAB1.<TYPE_DEPOT';
  24067. FINSI ;
  24068. SI (NON (EXISTE TAB1 <MODEL_CHAMP)) ;
  24069. TAB1.<MODEL_CHAMP = MOT 'SHAFRANOV' ;
  24070. MESS 'The poloidal magnetic field model is : SHAFRANOV';
  24071. FINSI;
  24072. SI (NON (EXISTE TAB1 <NBOB)) ;
  24073. TAB1.<NBOB = 18 ;
  24074. MESS 'The number of coils is : 18 ';
  24075. FINSI;
  24076. SI (NON (EXISTE TAB1 <NSPI)) ;
  24077. TAB1.<NSPI = 2028 ;
  24078. MESS 'The number of whorls in each coil is : 2028 ';
  24079. FINSI;
  24080.  
  24081. SI ((VALEUR DIME) EGA 2) ;
  24082. SI (NON (EXISTE TAB1 <PLAN)) ;
  24083. MESS 'You must give the kind of 2D section ';
  24084. ERRE '>>>> TAB1.<PLAN is missing ' ;
  24085. FINSI ;
  24086. SI (EGA TAB1.<PLAN 'THECONS') ;
  24087. SI (NON (EXISTE TAB1 <THETA0)) ;
  24088. MESS 'You must give the THETA angle locating';
  24089. MESS 'the part into the tokamak' ;
  24090. ERRE '>>>> TAB1.<THETA0 is missing ' ;
  24091. FINSI ;
  24092. SI (NON (EXISTE TAB1 CENTRE_PLASMA)) ;
  24093. MESS 'You must give the plasma center ';
  24094. ERRE '>>>> TAB1.CENTRE_PLASMA is missing';
  24095. FINSI ;
  24096. FINSI ;
  24097. SI (EGA TAB1.<PLAN 'PHICONS') ;
  24098. SI (NON (EXISTE TAB1 <CENTRE_TORE)) ;
  24099. MESS 'You must give the tokamak center' ;
  24100. ERRE '>>>> TAB1.<CENTRE_TORE is missing' ;
  24101. FINSI ;
  24102. SI (NON (EXISTE TAB1 <POINT_SUR_AXE_TORE)) ;
  24103. MESS 'You must give a second point on the tokamak axis';
  24104. ERRE '>>>> TAB1.<POINT_SUR_AXE_TORE is missing';
  24105. FINSI ;
  24106. SI (NON (EXISTE TAB1 <POINT_SUR_OBJET)) ;
  24107. MESS 'You must give a reference point on the part';
  24108. ERRE '>>>> TAB1.<POINT_SUR_OBJET is missing';
  24109. FINSI ;
  24110. FINSI ;
  24111. SI (NON (EXISTE TAB1 LFLUX_EXTE_DESS)) ;
  24112. TAB1.LFLUX_EXTE_DESS = TAB1.LFLUX_EXTE ;
  24113. FINSI ;
  24114. FINSI;
  24115.  
  24116. SI ((VALEUR DIME) EGA 3);
  24117. SI (NON (EXISTE TAB1 <CENTRE_TORE)) ;
  24118. MESS 'You must give the tokamak center' ;
  24119. ERRE '>>>> TAB1.<CENTRE_TORE is missing' ;
  24120. FINSI ;
  24121. SI (NON (EXISTE TAB1 <POINT_SUR_AXE_TORE)) ;
  24122. MESS 'You must give a second point on the tokamak axis';
  24123. ERRE '>>>> TAB1.<POINT_SUR_AXE_TORE is missing';
  24124. FINSI ;
  24125. SI (NON (EXISTE TAB1 <POINT_SUR_OBJET)) ;
  24126. MESS 'You must give a reference point on the part';
  24127. ERRE '>>>> TAB1.<POINT_SUR_OBJET is missing';
  24128. FINSI ;
  24129. FINSI ;
  24130.  
  24131. SI (NON (EXISTE TAB1 <ANG_PHI0)) ;
  24132. MESS 'You must give the initial toroidal angle ';
  24133. MESS 'locating the reference point of the part ';
  24134. MESS 'in the tokamak';
  24135. ERRE '>>>> TAB1.<ANG_PHI0 is missing' ;
  24136. FINSI ;
  24137. SI ((VALEUR DIME) EGA 3) ;
  24138. SI (NON (EXISTE TAB1 VIEW_P)) ;
  24139. TAB1.VIEW_P = -1000. 1000. 1000. ;
  24140. FINSI;
  24141. FINSI;
  24142. *
  24143. *---- norme du champ magnetique toroidal au centre du plasma
  24144. * rm 24.07.97 BTOR0 = 2.E-7 * TAB1.<NBOB * TAB1.<NSPI * TAB1.<INTENS / TAB1.<RP
  24145. ;
  24146. BTOR0 = -2.E-7 * TAB1.<NBOB * TAB1.<NSPI * TAB1.<INTENS / TAB1.<RP ;
  24147. MESS 'The toroidal magnetic field at the plasma center is (T): 'BTOR0;
  24148. *
  24149. MESS '---------------------------------> exiting @VDEFAUT ';
  24150. FINPROC ;
  24151.  
  24152. **** @VDEFJET
  24153.  
  24154. DEBPROC @VDEFJET TAB1*TABLE ;
  24155. *
  24156. **********************************************************************
  24157. * Procedure de preparation de la table TAB1 pour le calcul du profil *
  24158. * du depot de puissance par la procedure @CFPFLU. *
  24159. * On donne ici les valeurs par defaut et on verifie l'existence de *
  24160. * certains indices importants de la table. Alain MOAL (Fevrier 2001) *
  24161. **********************************************************************
  24162. * Modif : *
  24163. * 08/11/01 (A.MOAL) : test sur TAB1.<PUISSANCE_TOTALE et sur *
  24164. * TAB1.<SENS_REMONTEE *
  24165. * 27/01/04 (A.MOAL) : ajout de TAB1.<ANG_PHI0 = 0 et *
  24166. * TAB1.<POINT_SUR_OBJET pour utiliser les memes *
  24167. * procedures que pour @TOKAFLU *
  24168. **********************************************************************
  24169. *
  24170. MESS '---------------------------------> calling @VDEFJET ';
  24171. SI (NON (EXISTE TAB1 <IMESS)) ;
  24172. TAB1.<IMESS = 1 ;
  24173. MESS 'The level of message on screen is : 1';
  24174. FINSI;
  24175. SI (NON (EXISTE TAB1 <ITRAC)) ;
  24176. TAB1.<ITRAC = VRAI ;
  24177. MESS 'Drawings are printed on screen';
  24178. FINSI;
  24179. SI ((VALEUR DIME) EGA 2) ;
  24180. MESS 'Computation in 2 dimensions is not available';
  24181. ERRE '>>>> You must work in 3 dimensions' ;
  24182. FINSI;
  24183. SI ((VALEUR DIME) EGA 3);
  24184. SI (NON (EXISTE TAB1 <CENTRE_TORE)) ;
  24185. MESS 'The tokamak center is (0. 0. 0.)' ;
  24186. TAB1.<CENTRE_TORE = 0. 0. 0. ;
  24187. * MESS 'You must give the tokamak center' ;
  24188. * ERRE '>>>> TAB1.<CENTRE_TORE is missing' ;
  24189. FINSI ;
  24190. SI (NON (EXISTE TAB1 <POINT_SUR_AXE_TORE)) ;
  24191. MESS 'The vertical axis is defined by the point (0. 0. 1.)';
  24192. TAB1.<POINT_SUR_AXE_TORE = 0. 0. 1. ;
  24193. * MESS 'You must give a second point on the tokamak axis';
  24194. * ERRE '>>>> TAB1.<POINT_SUR_AXE_TORE is missing';
  24195. FINSI ;
  24196. *AM*27/01/04
  24197. TAB1.<ANG_PHI0 = 0. ;
  24198. TAB1.<POINT_SUR_OBJET = 1. 0. 0.;
  24199. FINSI ;
  24200. SI ((VALEUR DIME) EGA 3) ;
  24201. SI (NON (EXISTE TAB1 VIEW_P)) ;
  24202. TAB1.VIEW_P = -1000. 1000. 1000. ;
  24203. FINSI;
  24204. FINSI;
  24205. SI (NON (EXISTE TAB1 <TYPE_DEPOT)) ;
  24206. TAB1.<TYPE_DEPOT = VRAI ;
  24207. MESS 'The heat deposition is : PARALLELE';
  24208. FINSI;
  24209. SI (NON (EXISTE TAB1 <CALCUL_INCIDENCE)) ;
  24210. TAB1.<CALCUL_INCIDENCE = FAUX ;
  24211. FINSI;
  24212. SI (NON (EXISTE TAB1 <PUISSANCE_TOTALE)) ;
  24213. MESS 'You must give the total power deposited (MW)';
  24214. ERRE '>>>> TAB1.<PUISSANCE_TOTALE is missing' ;
  24215. FINSI;
  24216. SI (NON (EXISTE TAB1 <SENS_REMONTEE)) ;
  24217. TAB1.<SENS_REMONTEE = 0 ;
  24218. FINSI;
  24219. *
  24220. MESS '---------------------------------> exiting @VDEFJET ';
  24221. FINPROC ;
  24222.  
  24223. **** @VECADA
  24224. DEBPROC @VECADA <CHP1*CHPOINT <AMPL1*FLOTTANT <MOT1*MOT;
  24225. V_DIM1 = VALEUR 'DIME' ;
  24226. SI ( V_DIM1 EGA 2) ;
  24227. >VECT1 = VECTEUR <CHP1 <AMPL1 UX UY <MOT1;
  24228. SINON ;
  24229. >VECT1 = VECTEUR <CHP1 <AMPL1 UX UY UZ <MOT1 ;
  24230. FINSI ;
  24231. FINPROC >VECT1 ;
  24232. **** @VECGRAD
  24233. DEBPROC @VECGRAD TAB1*TABLE <CHP1*CHPOINT <AMPL1*FLOTTANT <MOT1*MOT;
  24234. MESS '---------------------------------> entree dans @VECGRAD';
  24235. MESS 'ATTENTION PAS ENCORE AU POINT !!!!!!!!!!!!!!!!!!!';
  24236. V1 = VALE DIME ;
  24237. SI (NON (EGA V1 2)) ;
  24238. MESS 'ERREUR dans lemploi de @VECGRAD...on nest pas en 2D' ERRE '@VECGRAD';
  24239. FINSI ;
  24240. S_TOT1 = TAB1.'M_ILLAGE_TOT';
  24241. CON_1 = TAB1.'M_IL_CONTOUR';
  24242. IZ = 0 ;
  24243. REPE BOU11 ;
  24244. IZ = IZ + 1 ;
  24245. SI ( NON ( EXISTE (TAB1.ZONE_MAT) IZ)) ;
  24246. QUITTER BOU11 ;
  24247. FINSI ;
  24248. MOD_1 = TAB1.DEF_MO.IZ ;
  24249. MAI_1 = TAB1.ZONE_MAT.IZ ;
  24250. CHT_2 = REDU <CHP1 MAI_1 ;
  24251. GR_1 = CHAN NOEUD (GRAD MOD_1 CHT_2) MOD_1;
  24252. GR_1 = CHAN CHPO GR_1 MOD_1;
  24253. VK_1 = @EVMAT TAB1.NOM_MAT.IZ 'CONDUCTIVITE' CHT_2 ;
  24254. VK_1 = NOMC 'SCAL' (-1. * VK_1 ) ;
  24255. FL_1 = VK_1 * GR_1;
  24256.  
  24257. CHN1 = MANU CHPO MAI_1 1 'SCAL' 1. ;
  24258.  
  24259.  
  24260. SI ( IZ EGA 1 ) ;
  24261. FL_T = FL_1 ;
  24262. CHN2 = CHN1 ;
  24263. LIST ((MAXI CHN2 ) - (MINI CHN2 ));
  24264. SINON ;
  24265. FL_T = FL_T ET FL_1 ;
  24266. CHN2 = CHN2 ET CHN1 ;
  24267. LIST ((MAXI CHN2 ) - (MINI CHN2 ));
  24268. FINSI ;
  24269. C_OLD = CC_1 ;
  24270. FIN BOU11 ;
  24271. FL_T = FL_T / CHN2;
  24272. >VECT1 = VECTEUR FL_T <AMPL1 T,X T,Y <MOT1;
  24273.  
  24274.  
  24275. MESS '---------------------------------> sortie de @VECGRAD';
  24276.  
  24277.  
  24278. FINPROC >VECT1;
  24279. **** @VERANG
  24280.  
  24281. DEBPROC @VERANG TAB1*TABLE ;
  24282. *
  24283. ********************************************************
  24284. * Procedure de creation de la ligne de reference (flux *
  24285. * normalise dans un fichier issu de PROTEUS) pour *
  24286. * verification des angles d'incidences. *
  24287. * Alain MOAL (Mars 2001) *
  24288. ********************************************************
  24289. *
  24290. MESS '---------------------------------> calling @VERANG';
  24291. *
  24292. *--------------- VARIABLES D'ENTREE :
  24293. NOM0 = TAB1.<NOM_FICHIER_F ;
  24294. *------------------------------------
  24295. *
  24296. OPTI ACQUERIR NOM0 ;
  24297. *---- lecture du nombre de lignes a lire dans le fichier
  24298. ACQU I*ENTIER ;
  24299. MESS '@VERANG IS READING 'I' LINES IN FILE 'NOM0 ;
  24300. *
  24301. *---- ligne de titre
  24302. ACQU MOT1*MOT MOT2*MOT MOT3*MOT MOT4*MOT MOT5*MOT MOT6*MOT MOT7*MOT ;
  24303. *
  24304. ACQU R0*FLOTTANT Z0*FLOTTANT DPSI1*FLOTTANT AEFF10*FLOTTANT DDPSI1*FLOTTANT PLEG1*FLOTTANT Q1*FLOTTANT ;
  24305. *
  24306. *---- creation du premier point
  24307. P0 = R0 0. Z0 ;
  24308. *
  24309. *
  24310. ACQU R1*FLOTTANT Z1*FLOTTANT DPSI1*FLOTTANT AEFF10*FLOTTANT DDPSI1*FLOTTANT PLEG1*FLOTTANT Q1*FLOTTANT ;
  24311. P1 = R1 0. Z1 ;
  24312. *
  24313. LIG1 = P0 D 1 P1 ;
  24314. *
  24315. *---- boucle sur les I-1 autres lignes du tableau
  24316. REPETER BOUC1 (I-2) ;
  24317. ACQU R1*FLOTTANT Z1*FLOTTANT DPSI1*FLOTTANT AEFF10*FLOTTANT DDPSI1*FLOTTANT PLEG1*FLOTTANT Q1*FLOTTANT ;
  24318. P1 = R1 0. Z1 ;
  24319. LIG1 = LIG1 D 1 P1 ;
  24320. FIN BOUC1 ;
  24321. *
  24322. *---- calcul des angles d'incidences
  24323. TAB1.<MAILLAGE_B = LIG1 ;
  24324. BR BZ BPHI = @MAGNB TAB1 ;
  24325. *
  24326. PHI = ATG (COOR 2 TAB1.<MAILLAGE_B) (COOR 1 TAB1.<MAILLAGE_B) ;
  24327. *AM*11/09/01*BX = BR * (COS PHI) + (BPHI * (SIN PHI));
  24328. *AM*11/09/01*BY = BR * (SIN PHI) - (BPHI * (COS PHI));
  24329. BX = BR * (COS PHI) - (BPHI * (SIN PHI));
  24330. BY = BR * (SIN PHI) + (BPHI * (COS PHI));
  24331. *
  24332. *---- Calcul des cosinus
  24333. B_NORM = ((BX*BX) + (BY*BY) + (BZ*BZ))**0.5 ;
  24334. COSR0 = BR / B_NORM ;
  24335. COSZ0 = BZ / B_NORM ;
  24336. COSP0 = BPHI / B_NORM ;
  24337. *
  24338. TITRE '@VERANG : COSINUS OF THE ANGLE BETWEEN b AND r AXIS' ;
  24339. EVOL1 = EVOL ROUG CHPO COSR0 LIG1 ;
  24340. DESS EVOL1 ;
  24341. LIST EVOL1 ;
  24342. *
  24343. TITRE '@VERANG : COSINUS OF THE ANGLE BETWEEN b AND z AXIS' ;
  24344. EVOL1 = EVOL ROUG CHPO COSZ0 LIG1 ;
  24345. DESS EVOL1 ;
  24346. LIST EVOL1 ;
  24347. *
  24348. TITRE '@VERANG : COSINUS OF THE ANGLE BETWEEN b AND phi AXIS' ;
  24349. EVOL1 = EVOL ROUG CHPO COSP0 LIG1 ;
  24350. DESS EVOL1 ;
  24351. LIST EVOL1 ;
  24352. *
  24353. MESS '---------------------------------> exiting @VERANG';
  24354. *
  24355. FINPROC ;
  24356.  
  24357. DEBPROC @VISIN TAB1*TABLE ;
  24358. *
  24359. *****************************************************************
  24360. * Procedure de visualisation de l'objet modelise positionne par *
  24361. * rapport au plasma. Cette procedure ne fonctionne qu'en 3D. *
  24362. * Alain MOAL (Aout 1995) *
  24363. *****************************************************************
  24364. *
  24365. OPTI ECHO 0 ;
  24366. MESS '---------------------------------> calling @VISIN';
  24367. *
  24368. *--------------- VARIABLES D'ENTREE :
  24369. MAIL0 = TAB1.<MAILLAGE ;
  24370. CP = TAB1.'CENTRE_PLASMA' ;
  24371. PT = TAB1.'PT_TGPLASMA' ;
  24372. THETA0 = TAB1.<THETA0 ;
  24373. RHO0 = TAB1.<RHO0 ;
  24374. RP = TAB1.<RP ;
  24375. *------------------------------------
  24376. *
  24377. SI (NON ((VALEUR DIME) EGA 3)) ;
  24378. ERRE '>>>> @VISIN only works on 3D geometries' ;
  24379. FINSI ;
  24380. *
  24381. *---- creation d'une nouvelle geometrie MAIL0V dans le repere local
  24382. *---- - l'origine O est placee au point tangent au plasma
  24383. *---- - l'axe OY est dirige vers le centre du plasma
  24384. *
  24385. VECT0 = CP MOINS PT ;
  24386. *
  24387. *---- verification de la valeur du petit rayon du plasma
  24388. RHO0 = NORM VECT0 ;
  24389. *---- verification que cette valeur est la meme que celle de TAB1.<RHO0
  24390. SI (EXISTE TAB1 <RHO0) ;
  24391. SI ((ABS ((RHO0 - TAB1.<RHO0)/RHO0)) > 1.E-4) ;
  24392. MESS '>>>> The computed value of the plasma radius is not';
  24393. MESS '>>>> the same as the given one in TAB1.<RHO0.';
  24394. MESS '>>>> You must check the coordinates of the CENTRE_PLASMA.';
  24395. ERRE ' >>>> ERROR in @VICIN' ;
  24396. FINSI ;
  24397. FINSI ;
  24398. *
  24399. VX = COOR 1 VECT0 ;
  24400. VY = COOR 2 VECT0 ;
  24401. VZ = COOR 3 VECT0 ;
  24402. P1 = 0. 0. 0. ;
  24403. P2 = 0. 0. 1. ;
  24404. VTRANS = PT MOINS P1 ;
  24405. SI (VY EGA 0.) ;
  24406. SI (VX EGA 0.) ;
  24407. ANG1 = 0. ;
  24408. FINSI ;
  24409. SI (VX > 0.) ;
  24410. ANG1 = 90. ;
  24411. FINSI ;
  24412. SI (VX < 0.) ;
  24413. ANG1 = -90. ;
  24414. FINSI ;
  24415. SINON ;
  24416. ANG1 = ATG VX VY ;
  24417. FINSI ;
  24418. *
  24419. MAIL0V = (MAIL0 MOINS VTRANS) TOUR ANG1 P1 P2 ;
  24420. *
  24421. VX1 = VX * (COS ANG1) - (VY * (SIN ANG1)) ;
  24422. VY1 = VX * (SIN ANG1) + (VY * (COS ANG1)) ;
  24423. VZ1 = VZ ;
  24424. *
  24425. SI (VY1 EGA 0.) ;
  24426. SI (VZ1 EGA 0.) ;
  24427. ANG2 = 0. ;
  24428. FINSI ;
  24429. SI (VZ1 > 0.) ;
  24430. ANG2 = -90. ;
  24431. FINSI ;
  24432. SI (VZ1 < 0.) ;
  24433. ANG2 = 90. ;
  24434. FINSI ;
  24435. SINON ;
  24436. ANG2 = -1.* (ATG VZ1 VY1) ;
  24437. FINSI ;
  24438. *
  24439. P1 = 0. 0. 0. ;
  24440. P2 = 1. 0. 0. ;
  24441. MAIL0V = MAIL0V TOUR ANG2 P1 P2 ;
  24442. *
  24443. *---- creation des axes du repere local :
  24444. *---- - l'origine O est placee au point tangent au plasma
  24445. *---- - l'axe OY est dirige vers le centre du plasma
  24446. *---- avec OX en bleu, OY en blanc, OZ en rouge
  24447. DENS 0.1 ;
  24448. OB1 = 0. 0. 0. ;
  24449. OB2 = .1 0. 0. ;
  24450. OB3 = 0. .1 0. ;
  24451. OB4 = 0. 0. .1 ;
  24452. LX = (D OB2 OB1) COUL BLEU ;
  24453. LY = (D OB3 OB1) COUL BLAN ;
  24454. LZ = (D OB4 OB1) COUL ROUG ;
  24455. MAIL0V = MAIL0V ET LX ET LY ET LZ ;
  24456. *TRACE (1000. -500. 1000.) FACE CACH MAIL0V ;
  24457. *
  24458. * ---- visualisation de la structure etudiee dans le tore
  24459. ABS1 = RHO0 * (SIN THETA0) * -1. ;
  24460. ABS2 = RHO0 * (COS THETA0) + RHO0 ;
  24461. ABS3 = RP * (COS THETA0) + RHO0 ;
  24462. ABS4 = RP * (SIN THETA0) ;
  24463. ABS5 = RHO0 * (SIN THETA0) ;
  24464. ABS6 = RHO0 * (COS(70.+THETA0)) + RHO0 ;
  24465. ABS7 = RHO0 * (SIN(70.+THETA0)) ;
  24466. ABS8 = RHO0 * (COS(70.-THETA0)) + RHO0 ;
  24467. ABS9 = RHO0 * (SIN(70.-THETA0)) * -1. ;
  24468. *
  24469. CPLASMA = 0. RHO0 0. ;
  24470. CTORE = 0. ABS2 ABS4 ;
  24471. CAUX1 = 0. ABS6 ABS7 ;
  24472. CAUX2 = 0. ABS8 ABS9 ;
  24473. CAUX3 = 0. ABS2 ABS5 ;
  24474. *
  24475. LIGPLAS = (CER3 OB1 CAUX1 CAUX2) ET (CER3 CAUX1 CAUX2 OB1) COUL ROSE ;
  24476. MAIL0V = MAIL0V ET LX ET LY ET LZ ET LIGPLAS ;
  24477. *TRACE (1000. -500. 1000.) FACE CACH MAIL0V;
  24478. *
  24479. * ----
  24480. MENAGE ;
  24481. ANGROT1 = -1.* THETA0 ;
  24482. VECT1 = 0. (-1.*RHO0*(COS THETA0) - RP) (RHO0*(SIN THETA0)) ;
  24483. MAIL0V = (MAIL0V TOUR ANGROT1 OB1 OB2) PLUS VECT1 ;
  24484. MAIL0V = MAIL0V TOUR 90. OB1 OB4 ;
  24485. CP1 = RP 0. 0. ;
  24486. CP2 = 0. 0. 1. ;
  24487. LIGTORE = (CP1 D 1 OB1 D 1 CP2) COUL TURQ ;
  24488. MAIL0V = MAIL0V ET LIGTORE ;
  24489. MENAGE ;
  24490. *
  24491. *---- multiplication des aiguilles sur le plancher
  24492. *aig* MAIL0V = MAIL0V ET (MAIL0V TOUR 0.7 OB1 OB4)
  24493. *aig* ET (MAIL0V TOUR 1.4 OB1 OB4)
  24494. *aig* ET (MAIL0V TOUR 2.1 OB1 OB4)
  24495. *aig* ET (MAIL0V TOUR 2.8 OB1 OB4) ;
  24496. *aig* MENAGE ;
  24497. *aig* MAIL0V = MAIL0V ET (MAIL0V TOUR 3.5 OB1 OB4) ;
  24498. *aig* MENAGE ;
  24499. *
  24500. TITRE 'POSITION OF THE MODELISED STRUCTURE IN THE TORE' ;
  24501. TRACE (0. -1000. 0.) FACE CACH MAIL0V ;
  24502. MESS '---------------------------------> exiting @VISIN';
  24503. FINPROC ;
  24504. DEBPROC @VISIN TAB1*TABLE ;
  24505. *
  24506. *****************************************************************
  24507. * Procedure de visualisation de l'objet modelise positionne par *
  24508. * rapport au plasma. Cette procedure ne fonctionne qu'en 3D. *
  24509. * Alain MOAL (Aout 1995) *
  24510. *****************************************************************
  24511. *
  24512. OPTI ECHO 0 ;
  24513. MESS '---------------------------------> calling @VISIN';
  24514. *
  24515. *--------------- VARIABLES D'ENTREE :
  24516. MAIL0 = TAB1.<MAILLAGE ;
  24517. CP = TAB1.'CENTRE_PLASMA' ;
  24518. PT = TAB1.'PT_TGPLASMA' ;
  24519. THETA0 = TAB1.<THETA0 ;
  24520. RHO0 = TAB1.<RHO0 ;
  24521. RP = TAB1.<RP ;
  24522. *------------------------------------
  24523. *
  24524. SI (NON ((VALEUR DIME) EGA 3)) ;
  24525. ERRE '>>>> @VISIN only works on 3D geometries' ;
  24526. FINSI ;
  24527. *
  24528. *---- creation d'une nouvelle geometrie MAIL0V dans le repere local
  24529. *---- - l'origine O est placee au point tangent au plasma
  24530. *---- - l'axe OY est dirige vers le centre du plasma
  24531. *
  24532. VECT0 = CP MOINS PT ;
  24533. *
  24534. *---- verification de la valeur du petit rayon du plasma
  24535. RHO0 = NORM VECT0 ;
  24536. *---- verification que cette valeur est la meme que celle de TAB1.<RHO0
  24537. SI (EXISTE TAB1 <RHO0) ;
  24538. SI ((ABS ((RHO0 - TAB1.<RHO0)/RHO0)) > 1.E-4) ;
  24539. MESS '>>>> The computed value of the plasma radius is not';
  24540. MESS '>>>> the same as the given one in TAB1.<RHO0.';
  24541. MESS '>>>> You must check the coordinates of the CENTRE_PLASMA.';
  24542. ERRE ' >>>> ERROR in @VISIN' ;
  24543. FINSI ;
  24544. FINSI ;
  24545. *
  24546. VX = COOR 1 VECT0 ;
  24547. VY = COOR 2 VECT0 ;
  24548. VZ = COOR 3 VECT0 ;
  24549. P1 = 0. 0. 0. ;
  24550. P2 = 0. 0. 1. ;
  24551. VTRANS = PT MOINS P1 ;
  24552. SI (VY EGA 0.) ;
  24553. SI (VX EGA 0.) ;
  24554. ANG1 = 0. ;
  24555. FINSI ;
  24556. SI (VX > 0.) ;
  24557. ANG1 = 90. ;
  24558. FINSI ;
  24559. SI (VX < 0.) ;
  24560. ANG1 = -90. ;
  24561. FINSI ;
  24562. SINON ;
  24563. ANG1 = ATG VX VY ;
  24564. FINSI ;
  24565. *
  24566. MAIL0V = (MAIL0 MOINS VTRANS) TOUR ANG1 P1 P2 ;
  24567. *
  24568. VX1 = VX * (COS ANG1) - (VY * (SIN ANG1)) ;
  24569. VY1 = VX * (SIN ANG1) + (VY * (COS ANG1)) ;
  24570. VZ1 = VZ ;
  24571. *
  24572. SI (VY1 EGA 0.) ;
  24573. SI (VZ1 EGA 0.) ;
  24574. ANG2 = 0. ;
  24575. FINSI ;
  24576. SI (VZ1 > 0.) ;
  24577. ANG2 = -90. ;
  24578. FINSI ;
  24579. SI (VZ1 < 0.) ;
  24580. ANG2 = 90. ;
  24581. FINSI ;
  24582. SINON ;
  24583. ANG2 = -1.* (ATG VZ1 VY1) ;
  24584. FINSI ;
  24585. *
  24586. P1 = 0. 0. 0. ;
  24587. P2 = 1. 0. 0. ;
  24588. MAIL0V = MAIL0V TOUR ANG2 P1 P2 ;
  24589. *
  24590. *---- creation des axes du repere local :
  24591. *---- - l'origine O est placee au point tangent au plasma
  24592. *---- - l'axe OY est dirige vers le centre du plasma
  24593. *---- avec OX en bleu, OY en blanc, OZ en rouge
  24594. DENS 0.1 ;
  24595. OB1 = 0. 0. 0. ;
  24596. OB2 = .1 0. 0. ;
  24597. OB3 = 0. .1 0. ;
  24598. OB4 = 0. 0. .1 ;
  24599. LX = (D OB2 OB1) COUL BLEU ;
  24600. LY = (D OB3 OB1) COUL BLAN ;
  24601. LZ = (D OB4 OB1) COUL ROUG ;
  24602. MAIL0V = MAIL0V ET LX ET LY ET LZ ;
  24603. *TRACE (1000. -500. 1000.) FACE CACH MAIL0V ;
  24604. *
  24605. * ---- visualisation de la structure etudiee dans le tore
  24606. ABS1 = RHO0 * (SIN THETA0) * -1. ;
  24607. ABS2 = RHO0 * (COS THETA0) + RHO0 ;
  24608. ABS3 = RP * (COS THETA0) + RHO0 ;
  24609. ABS4 = RP * (SIN THETA0) ;
  24610. ABS5 = RHO0 * (SIN THETA0) ;
  24611. ABS6 = RHO0 * (COS(70.+THETA0)) + RHO0 ;
  24612. ABS7 = RHO0 * (SIN(70.+THETA0)) ;
  24613. ABS8 = RHO0 * (COS(70.-THETA0)) + RHO0 ;
  24614. ABS9 = RHO0 * (SIN(70.-THETA0)) * -1. ;
  24615. *
  24616. CPLASMA = 0. RHO0 0. ;
  24617. CTORE = 0. ABS2 ABS4 ;
  24618. CAUX1 = 0. ABS6 ABS7 ;
  24619. CAUX2 = 0. ABS8 ABS9 ;
  24620. CAUX3 = 0. ABS2 ABS5 ;
  24621. *
  24622. LIGPLAS = (CER3 OB1 CAUX1 CAUX2) ET (CER3 CAUX1 CAUX2 OB1) COUL ROSE ;
  24623. MAIL0V = MAIL0V ET LX ET LY ET LZ ET LIGPLAS ;
  24624. *TRACE (1000. -500. 1000.) FACE CACH MAIL0V;
  24625. *
  24626. * ----
  24627. MENAGE ;
  24628. ANGROT1 = -1.* THETA0 ;
  24629. VECT1 = 0. (-1.*RHO0*(COS THETA0) - RP) (RHO0*(SIN THETA0)) ;
  24630. MAIL0V = (MAIL0V TOUR ANGROT1 OB1 OB2) PLUS VECT1 ;
  24631. MAIL0V = MAIL0V TOUR 90. OB1 OB4 ;
  24632. CP1 = RP 0. 0. ;
  24633. CP2 = 0. 0. 1. ;
  24634. LIGTORE = (CP1 D 1 OB1 D 1 CP2) COUL TURQ ;
  24635. MAIL0V = MAIL0V ET LIGTORE ;
  24636. MENAGE ;
  24637. *
  24638. *---- multiplication des aiguilles sur le plancher
  24639. *aig* MAIL0V = MAIL0V ET (MAIL0V TOUR 0.7 OB1 OB4)
  24640. *aig* ET (MAIL0V TOUR 1.4 OB1 OB4)
  24641. *aig* ET (MAIL0V TOUR 2.1 OB1 OB4)
  24642. *aig* ET (MAIL0V TOUR 2.8 OB1 OB4) ;
  24643. *aig* MENAGE ;
  24644. *aig* MAIL0V = MAIL0V ET (MAIL0V TOUR 3.5 OB1 OB4) ;
  24645. *aig* MENAGE ;
  24646. *
  24647. TITRE '@VISIN : MODELISED STRUCTURE IN THE TORE' ;
  24648. TRACE (0. -1000. 0.) FACE CACH MAIL0V ;
  24649. MESS '---------------------------------> exiting @VISIN';
  24650. FINPROC ;
  24651.  
  24652. DEBPROC @VISRES TAB1*TABLE ;
  24653. *
  24654. ******************************************************************
  24655. * Procedure de visualisation des resultats d'un calcul permanent *
  24656. * en 3D. Alain MOAL (aout-sept 1995) *
  24657. ******************************************************************
  24658. *
  24659. MESS '---------------------------------> calling @VISRES';
  24660. *
  24661. ITER = 1 ;
  24662. *--------------- VARIABLES D'ENTREE :
  24663. MAIL0 = TAB1.<MAILLAGE ;
  24664. TEMP = TAB1.TEMPERATURE ;
  24665. LIGCONV = TAB1.LFLUX_CONV_DESS ;
  24666. SURFCONV = TAB1.LFLUX_CONV ;
  24667. SURFEXTE = TAB1.LFLUX_EXTE ;
  24668. TE1 = TAB1.ITER ;
  24669. VTETA1 = TAB1.RESUTHER.'VALEUR_TETA'.ITER ;
  24670. HCONV1 = TAB1.RESUTHER.COEFECHANGE.ITER ;
  24671. PROFIL0 = TAB1.V_VPAT1 ;
  24672. FLU0 = EXTR TAB1.LIS_FLUX ITER;
  24673. MODEL0 = TAB1.MODELF ;
  24674. LIG0 = TAB1.LFLUX_EXTE_DESS ;
  24675. MAXSOFL = TAB1.MAX_SOFL ;
  24676. DMAQ0 = TAB1.D_MAQUETTE ;
  24677. NX = TAB1.C_COTETF1 ;
  24678. NY = TAB1.C_SITETF1 ;
  24679. NZ = TAB1.C_COS3F1 ;
  24680. VOLMAT1 = TAB1.ZONE_MAT.1 ;
  24681. VOLMAT2 = TAB1.ZONE_MAT.2 ;
  24682. VOLMAT3 = TAB1.ZONE_MAT.3 ;
  24683. ANGINCI = TAB1.<ANGINCI;
  24684. *TEST*VBVN = TAB1.<VBVN ;
  24685. SI ((DIME TAB1.<POINT_COUPE) EGA 3) ;
  24686. P1 = TEXT (EXTR TAB1.<POINT_COUPE 1) ;
  24687. P2 = TEXT (EXTR TAB1.<POINT_COUPE 2) ;
  24688. P3 = TEXT (EXTR TAB1.<POINT_COUPE 3) ;
  24689. SINON ;
  24690. ERRE '>>>> @VISRES : check TAB1.<POINT_COUPE' ;
  24691. FINSI ;
  24692. SI ((VALEUR DIME) EGA 3) ;
  24693. OEIL0 = TAB1.VIEW_P ;
  24694. SINON ;
  24695. ERRE '>>>> @VISRES only works on 3D geometries' ;
  24696. FINSI ;
  24697. *------------------------------------
  24698. *
  24699. *---- Table de visualisation
  24700. TAB2 = TABLE ;
  24701. TAB2.1 = 'MARQ CROI REGU MOT TITR FLUX' ;
  24702. TAB2.2 = 'MARQ TRIA REGU MOT TITR TEMPERATURE' ;
  24703. *
  24704. SI ((VALEUR DIME) NEG 3) ;
  24705. ERRE '>>>> @VISRES only works on 3D modelisations';
  24706. FINSI ;
  24707. *
  24708. FLU1 = FLU0 * PROFIL0 ;
  24709. *
  24710. *---- Trace du flux incident, de la temperature et de l'angle d'incidence
  24711. *---- le long d'une ligne en fonction de l'abscisse curviligne
  24712. XM = COOR 1 LIG0 ;
  24713. LIG2 = CHAN SEG2 LIG0 ;
  24714. XCUR = EXTR (EVOL CHPO XM SCAL (INVE LIG0)) ABSC ;
  24715. CHXCUR = MANU CHPO (INVE LIG2) 1 SCAL XCUR ;
  24716. FLUXI = NOMC SCAL FLU1 ;
  24717. TEMP1 = NOMC SCAL TEMP ;
  24718. TITRE ' @VISRES : INCIDENT FLUX (W/m2) AND TEMPERATURE (1.E-4*C)';
  24719. EVFLUI = EVOL JAUN CHPO FLUXI SCAL LIG0 ;
  24720. EVTEMI = EVOL ROUG CHPO (TEMP1*1.E4) SCAL LIG0 ;
  24721. DESSIN (EVFLUI ET EVTEMI) MIMA LEGE TAB2 ;
  24722. TITRE ' @VISRES : ANGLE BETWEEN B AND N (degree)';
  24723. EVANGI = EVOL JAUN CHPO ANGINCI SCAL LIG0 ;
  24724. DESSIN EVANGI MIMA ;
  24725. *TEST*TITRE ' @VISRES : VBVN ';
  24726. *TEST*EVVBVN = EVOL JAUN CHPO VBVN SCAL LIG0 ;
  24727. *TEST*DESSIN EVVBVN MIMA ;
  24728. *
  24729. *---- Trace de l'evolution du flux de convection le long d'une ligne
  24730. VTETA0 = REDU (EXCO 'T' TE1) LIGCONV ;
  24731. SI (EGA (TYPE VTETA1) 'CHPOINT ');
  24732. VTETA = EXCO 'T' VTETA1 ;
  24733. SINON ;
  24734. VTETA = VTETA1 ;
  24735. FINSI ;
  24736. HCONV = EXCO 'H' HCONV1 ;
  24737. *
  24738. *---- flux de convection sur la ligne et temperatures sur la ligne
  24739. FLUCONV = HCONV * (VTETA0 - VTETA) ;
  24740. TITRE '@VISRES : WALL FLUX (W/m2) AND WALL TEMPERATURE (1.E-5*C)' ;
  24741. EVFLUC = EVOL VERT CHPO FLUCONV SCAL LIGCONV ;
  24742. EVTEMC = EVOL TURQ CHPO (TEMP1*1.E5) SCAL LIGCONV ;
  24743. DESSIN (EVFLUC ET EVTEMC) MIMA LEGE TAB2 ;
  24744. *
  24745. *---- temperatures sur la ligne
  24746. *TITRE '@VISRES : WALL TEMPERATURE (C)' ;
  24747. *DESSIN (EVOL TURQ CHPO TEMP1 SCAL LIGCONV) MIMA ;
  24748. *
  24749. *---- flux de convection sur la surface de convection
  24750. FLUCONV0 = HCONV * (TE1 - VTETA) ;
  24751. *
  24752. *---- Calcul du facteur de concentration et de la puissance extraite
  24753. FACT0 = (MAXI FLUCONV0) / (MAXI FLU1);
  24754. FLUINT1 = FLUX MODEL0 FLU1 ;
  24755. FLUMOY = (MAXI(RESU FLUINT1)) / (MESU SURFEXTE) ;
  24756. PUI1 = MAXI(RESU FLUINT1) ;
  24757. *
  24758. *---- Trace en coupe des isovaleurs de temperature et des vecteurs flux
  24759. *---- incident et de convection
  24760. CHPX = EXCO SCAL (FLU1 * NX) UX ;
  24761. CHPY = EXCO SCAL (FLU1 * NY) UY ;
  24762. CHPZ = EXCO SCAL (FLU1 * NZ) UZ ;
  24763. CHPT = @ET (@ET CHPX CHPY) CHPZ ;
  24764. AMPLV1 = 10. * DMAQ0 / (2. * MAXSOFL) ;
  24765. VECFLUI = @VECADA CHPT (-1. * AMPLV1) 'ROUGE' ;
  24766. *FX = FLU1 * NX;
  24767. *FY = FLU1 * NY;
  24768. *FZ = FLU1 * NZ;
  24769. *VECFLUI = @CVECT FX FY FZ SURFEXTE VERT ;
  24770. TITRE '@VISRES : ISOTHERM IN SECTION' ;
  24771. TRAC OEIL0 COUPE P1 P2 P3 TEMP MAIL0;
  24772. *
  24773. *---- Trace des isovaleurs de temperature sans le maillage
  24774. TITRE '@VISRES : ISOTHERM, CONVECTED POWER 'PUI1' W';
  24775. SI (EGA (VALEUR ELEM) 'CUB8') ;
  24776. ARET1 = ARETE VOLMAT1 ;
  24777. ARET2 = ARETE VOLMAT2 ;
  24778. ARET3 = ARETE VOLMAT3 ;
  24779. SINON ;
  24780. ARET1 = ARETE VOLMAT1 40.;
  24781. ARET2 = ARETE VOLMAT2 40.;
  24782. ARET3 = ARETE VOLMAT3 40.;
  24783. FINSI ;
  24784. ARET0 = ARET1 ET ARET2 ET ARET3 ;
  24785. TRAC 7 CACH OEIL0 TEMP MAIL0 ARET0 ;
  24786. TRAC CACH OEIL0 TEMP MAIL0 ARET0 ;
  24787. *
  24788. *---- Messages
  24789. MESS ' HIGHEST WALL TEMPERATURE (C)..........: ' (MAXI VTETA0);
  24790. MESS ' LOWEST WALL TEMPERATURE (C)...........: ' (MINI VTETA0);
  24791. MESS ' MEAN INCIDENT FLUX (W/m2).............: ' FLUMOY ;
  24792. MESS ' HIGHEST INCIDENT FLUX (W/m2)..........: ' (MAXI FLU1) ;
  24793. MESS ' LOWEST INCIDENT FLUX (W/m2)...........: ' (MINI FLU1) ;
  24794. MESS ' HIGHEST CONVECTION FLUX (W/m2)........: ' (MAXI FLUCONV0);
  24795. MESS ' LOWEST CONVECTION FLUX (W/m2).........: ' (MINI FLUCONV0);
  24796. MESS ' CONCENTRATION FACTOR .................: ' FACT0 ;
  24797. *
  24798. MESS '---------------------------------> exiting @VISRES';
  24799. FINPROC ;
  24800. **** @VNORM3D
  24801. DEBPROC @VNORM3D <MAIL1*MAILLAGE <MAILD_1*MAILLAGE NIVEAU1/ENTIER;
  24802. *
  24803. * !!! R. MITTEAU !!! attention, procedure standard
  24804. *
  24805. * un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
  24806. * pour les mises a jour
  24807. *
  24808. SI (NON (EXISTE NIVEAU1));
  24809. MESS '---------------------------------> calling @VNORM3D';
  24810. SINON;
  24811. SI (NIVEAU1 >EG 4);
  24812. MESS '---------------------------------> calling @VNORM3D';
  24813. FINSI;
  24814. FINSI;
  24815. SI (EGA (VALE MODE) 'AXIS') ;
  24816. FX = 'FR' ;
  24817. FY = 'FZ' ;
  24818. FINSI ;
  24819. MODL1 = MODE <MAIL1 'MECANIQUE' 'ELASTIQUE' ;
  24820. FPREF1 = PRESSION MASS MODL1 -1.E5 <MAILD_1 ;
  24821. XFF1 = ( EXCO FX FPREF1 'SCAL' ) ;
  24822. YFF1 = ( EXCO FY FPREF1 'SCAL' ) ;
  24823. V_DIM1 = VALEUR 'DIME' ;
  24824. SI ( V_DIM1 EGA 2) ;
  24825. NORMDP1 = ( (XFF1**2) + (YFF1**2) )**0.5;
  24826. >COSDIR1 = XFF1 / NORMDP1 ;
  24827. >COSDIR2 = YFF1 / NORMDP1 ;
  24828. >COSDIR3 = >COSDIR1 * 0. ;
  24829. SINON ;
  24830. ZFF1 = ( EXCO FZ FPREF1 'SCAL' ) ;
  24831. NORMDP1 = ( (XFF1**2) + (YFF1**2) + (ZFF1**2) )**0.5 ;
  24832. >COSDIR1 = XFF1 / NORMDP1 ;
  24833. >COSDIR2 = YFF1 / NORMDP1 ;
  24834. >COSDIR3 = ZFF1 / NORMDP1 ;
  24835. FPREF2 = @ET ( MANU CHPO <MAIL1 3 FX 0. FY 0. FZ 0.) FPREF1 ;
  24836. CH_1 = CHAN 'CHAM' FPREF2 MODL1 'GRAVITE';
  24837. CHPO1 = REDU <MAILD_1 (CHAN 'CHPO' MODL1 CH_1) ;
  24838. SENS1 = PSCAL FPREF1 CHPO1 (MOTS FX FY FZ) (MOTS FX FY FZ) ;
  24839.  
  24840. MASQ1 = SENS1 MASQUE INFERIEUR 0. ;
  24841. MASQ2 = SENS1 MASQUE EGSUPE 0. ;
  24842. MASQ3 = @ET (-1. * MASQ1) MASQ2 ;
  24843.  
  24844. >COSDIR1 = >COSDIR1 * MASQ3 ;
  24845. >COSDIR2 = >COSDIR2 * MASQ3 ;
  24846. >COSDIR3 = >COSDIR3 * MASQ3 ;
  24847. FINSI ;
  24848.  
  24849. SI (NON (EXISTE NIVEAU1));
  24850. MESS '---------------------------------> exiting @VNORM3D';
  24851. SINON;
  24852. SI (NIVEAU1 >EG 4);
  24853. MESS '---------------------------------> exiting @VNORM3D';
  24854. FINSI;
  24855. FINSI;
  24856.  
  24857. FINPROC >COSDIR1 >COSDIR2 >COSDIR3 ;
  24858. **** @VNORMAL
  24859. DEBPROC VNORMAL <MAIL1*MAILLAGE <MAILD_1*MAILLAGE ;
  24860. MESS '---------------------------------> Entree dans VNORMAL ' ;
  24861. MODL1 = MODE <MAIL1 'MECANIQUE' 'ELASTIQUE' ;
  24862. FPREF1 = PRESSION MASS MODL1 1.E5 <MAILD_1 ;
  24863. XFF1 = ( EXCO FX FPREF1 'SCAL' ) * -1. ;
  24864. YFF1 = ( EXCO FY FPREF1 'SCAL' ) * -1. ;
  24865. >TETHA1 = ATG YFF1 ( XFF1 + 1.E-12) ;
  24866. >COS1 = ( COS >TETHA1 ) * 1. ;
  24867. >SIN1 = ( SIN >TETHA1 ) * 1. ;
  24868. MESS '---------------------------------> sortie de VNORMAL' ;
  24869. FINPROC >TETHA1 >COS1 >SIN1 ;
  24870.  
  24871.  
  24872.  
  24873.  
  24874. OPTI ECHO 1 ;
  24875.  
  24876. *****************************************************************
  24877. * CAS TEST - DIVERTOR DE JET (OMBRAGE DE 2 TUILES) *
  24878. * Alain MOAL - CS SI - Novembre 2001 *
  24879. *****************************************************************
  24880. * setenv ESOPE_PARAM 'ESOPE=90000000,NTRK=20000,LTRK=8192'
  24881. *
  24882.  
  24883. emp1 = 'CHAINE' DIVERS '/champbred' ;
  24884. *emp1 = 'MOT' '/export/home/castem2001/DGIBI/champbred' ;
  24885. emp2= 'CHAINE' DIVERS '/flux1mwmo';
  24886. *emp2 = 'MOT' '/export/home/castem2001/DGIBI/flux1mwmo';
  24887.  
  24888.  
  24889.  
  24890. OPTI DIME 3 ELEM CUB8 ;
  24891. *OPTI ISOV LIGNE ;
  24892. OPTI TRAC PS ;
  24893.  
  24894. OEIL0 = 1000. -1000. 1000. ;
  24895.  
  24896. *---- repere du maillage
  24897. DIRX1 = (0. 0. 0.) D 1 (1. 0. 0.) ;
  24898. DIRY1 = (0. 0. 0.) D 1 (0. 1. 0.) ;
  24899. DIRZ1 = (0. 0. 0.) D 1 (0. 0. 1.) ;
  24900. REP1 = (DIRX1 ET DIRY1 ET DIRZ1) COUL ROUG ;
  24901.  
  24902. *---- maillage du divertor (nouvelles donnees)
  24903. P1 = 2.0481 0. -0.9298 ;
  24904. P2 = 2.1316 0. -1.1314 ;
  24905. P3 = 2.1316 0. -1.1314 ;
  24906. P4 = 2.1918 0. -1.26 ;
  24907. P5 = 2.16322 0. -1.29362 ;
  24908. P6 = 2.19327 0. -1.26498 ;
  24909. P7 = 2.19327 0. -1.26498 ;
  24910. P8 = 2.26575 0. -1.33958 ;
  24911. P9 = 2.26575 0. -1.33958 ;
  24912. P10 = 2.37075 0. -1.44671 ;
  24913. P11 = 2.36136 0. -1.46418 ;
  24914. P12 = 2.37794 0. -1.57550 ;
  24915. P13 = 2.36699 0. -1.58250 ;
  24916. P14 = 2.38105 0. -1.67954 ;
  24917. P15 = 2.30389 0. -1.74718 ;
  24918. P16 = 2.42874 0. -1.68831 ;
  24919. P17 = 2.43246 0. -1.68478 ;
  24920. P18 = 2.51123 0. -1.61943 ;
  24921. P19 = 2.51123 0. -1.61943 ;
  24922. P20 = 2.53700 0. -1.61850 ;
  24923. P21 = 2.53700 0. -1.61850 ;
  24924. P22 = 2.53800 0. -1.65752 ;
  24925. P23 = 2.54800 0. -1.65210 ;
  24926. P24 = 2.54900 0. -1.62150 ;
  24927. P25 = 2.54900 0. -1.62150 ;
  24928. P26 = 2.59146 0. -1.61898 ;
  24929. P27 = 2.59146 0. -1.61898 ;
  24930. P28 = 2.73111 0. -1.67580 ;
  24931. P29 = 2.73532 0. -1.68017 ;
  24932. P30 = 2.90976 0. -1.75035 ;
  24933. P31 = 2.84945 0. -1.67749 ;
  24934. P32 = 2.84645 0. -1.56949 ;
  24935. P33 = 2.83476 0. -1.55182 ;
  24936. P34 = 2.88572 0. -1.43545 ;
  24937. P35 = 2.88638 0. -1.41798 ;
  24938. P36 = 3.03457 0. -1.31055 ;
  24939. P37 = 3.03457 0. -1.31055 ;
  24940. P38 = 3.06033 0. -1.34561 ;
  24941.  
  24942. N0 = 3 ;
  24943. N1 = 4 ;
  24944. N2 = 1 ;
  24945. ANG0 = 3. ;
  24946.  
  24947. N23_24 = 4 ;
  24948. N25_26 = 3 ;
  24949. N27_28 = 4 ;
  24950. N29_30 = 4 ;
  24951. N31_32 = 1 ;
  24952.  
  24953. *---- tuile 6
  24954. L23_24 = P23 D N23_24 P24 ;
  24955. L25_26 = P25 D N25_26 P26 ;
  24956. L27_28 = P27 D N27_28 P28 ;
  24957. S23_28 = (L25_26 ET L27_28) ROTA N1 ANG0 (0. 0. 0.) (0. 0. 1.) ;
  24958. ELIM 0.001 S23_28 ;
  24959. V23_28 = S23_28 VOLU TRAN N2 (0. 0. -0.02) ;
  24960.  
  24961. *---- tuile 7
  24962. L29_30 = P29 D N29_30 P30 ;
  24963. S29_30 = L29_30 ROTA N1 ANG0 (0. 0. 0.) (0. 0. 1.) ;
  24964. ELIM 0.01 S29_30 ;
  24965. V29_30 = S29_30 VOLU TRAN N2 (0. 0. -0.02) ;
  24966.  
  24967. MAIL0 = V23_28 ET V29_30 ;
  24968. SURF0 = S23_28 ET S29_30 ;
  24969. LIG0 = L25_26 ET L27_28 ET (P28 D 1 P29) ET L29_30 ;
  24970.  
  24971. TITRE ' ' ;
  24972. TRAC OEIL0 (MAIL0 ET (SURF0 COUL ROUG) ET REP1) ;
  24973. *OPTI DONN 5;
  24974.  
  24975. *---- donnees pour CFPFLU
  24976. TAB1 = TABLE ;
  24977. TAB1.VIEW_P = OEIL0 ;
  24978. TAB1.<MAILLAGE = MAIL0 ;
  24979. TAB1.LFLUX_EXTE = SURF0 ;
  24980. TAB1.<NOM_FICHIER_B = emp1;
  24981. TAB1.<NOM_FICHIER_F = emp2 ;
  24982. TAB1.<EXTENSION_TORO = ANG0 ;
  24983. TAB1.<NBELEM_TORO = N1 ;
  24984. TAB1.MODELF = MODE MAIL0 THERMIQUE ISOTROPE ;
  24985. TAB1.<LONGUEUR_PAS_SANS_TEST = 0.05 ;
  24986. TAB1.<LONGUEUR_PAS_AVEC_TEST = 0.05 ;
  24987. TAB1.<PUISSANCE_TOTALE = 2. ;
  24988.  
  24989. FLU0 = @CFPFLU TAB1 ;
  24990.  
  24991. *---- trace sur la ligne
  24992.  
  24993. TITRE 'FLUX' ;
  24994. EVOL1 = EVOL ROUG CHPO (REDU FLU0 LIG0) LIG0 ;
  24995.  
  24996. DESS EVOL1 ;
  24997.  
  24998. *OPTI DONN 5 ;
  24999.  
  25000. *---- donnees pour OMBJET (ombrage tuile 8 sur tuile 7)
  25001.  
  25002. *---- tuile 8 (extension toroidale)
  25003. ANG1 = 20. ;
  25004. N1 = 10 ;
  25005. LTUI8 = P31 D N31_32 P32 ;
  25006. STUI8 = LTUI8 ROTA N1 ANG1 (0. 0. 0.) (0. 0. 1.) ;
  25007. ELIM 0.01 STUI8 ;
  25008. VTUI8 = STUI8 VOLU TRAN N2 (0.1 0. 0.) ;
  25009.  
  25010. TAB1.<NOM_FICHIER_B = emp1 ;
  25011. TAB1.<EXTENSION_TORO = ANG1+3. ;
  25012. TAB1.<NBELEM_TORO = 7 ;
  25013. TAB1.<S_OMBRE = DEPL SURF0 TOUR (ANG1/2.) (0. 0. 0.) (0. 0. 1.) ;
  25014. TAB1.<V_OMBRE_N = DEPL MAIL0 TOUR (ANG1/2.) (0. 0. 0.) (0. 0. 1.);
  25015. TAB1.<S_OMBRE_N = TAB1.<S_OMBRE ;
  25016. TAB1.<S_OMBRANT = ENVE VTUI8 ;
  25017. TAB1.<V_OMBRANT_N = VTUI8 ;
  25018. TAB1.<S_OMBRANT_N = TAB1.<S_OMBRANT ;
  25019. TAB1.<METHODE_REMONTEE = 1 ;
  25020. TAB1.<DIST_SANS_TEST = 0.20 ;
  25021. TAB1.<PAS_SANS_TEST = 0.025 ;
  25022. TAB1.<DIST_AVEC_TEST = 0.70 ;
  25023. TAB1.<PAS_AVEC_TEST = 0.025 ;
  25024. TAB1.<SENS_REMONTEE = -1. ;
  25025.  
  25026. TAB1.<REMONTEE = TABLE ;
  25027. TAB1.<REMONTEE.<POINT = TABLE ;
  25028. TAB1.<REMONTEE.<POINT. 1 = SURF0 POIN 1 ;
  25029. TAB1.<REMONTEE.<POINT. 2 = SURF0 POIN 25;
  25030. TAB1.<REMONTEE.<POINT. 3 = SURF0 POIN 40;
  25031.  
  25032. @OMBJET TAB1 ;
  25033.  
  25034. TITRE 'LIGNES DE CHAMP' ;
  25035. TRAC OEIL0 (SURF0 ET ((TAB1.<REMONTEE.<LIGNE. 1 ET TAB1.<REMONTEE.<LIGNE. 2 ET TAB1.<REMONTEE.<LIGNE. 3) COUL ROUG)) ;
  25036.  
  25037. TITRE 'CONNECTION DISTANCE' ;
  25038. TRAC TAB1.<CHDIST SURF0 ;
  25039.  
  25040. TITRE 'OMBRE EN BLEU';
  25041. TRAC TAB1.<MASQOMB SURF0 ;
  25042.  
  25043.  
  25044. *---- correction du flux avec l'ombrage
  25045. *MASK0 = TAB1.<CHDIST MASQUE 'SUPERIEUR'
  25046. * (TAB1.<DIST_SANS_TEST + TAB1.<DIST_AVEC_TEST - 0.05) ;
  25047. TITRE 'FLUX CORRIGE PAR L OMBRAGE';
  25048. *TRAC MASK0 SURF0 ;
  25049. TRAC (FLU0 * (TAB1.<MASQOMB)) SURF0;
  25050.  
  25051. *---- validation du resultat
  25052. PO1 = 2.4761 0.97536 -1.6474 ;
  25053. PO2 = 2.8009 0.60813 -1.7528 ;
  25054. VAL0 = EXTR TAB1.<CHDIST SCAL (SURF0 POIN PROC PO1);
  25055. VAL1 = EXTR TAB1.<CHDIST SCAL (SURF0 POIN PROC PO2) ;
  25056. VAL2 = EXTR (FLU0 * (TAB1.<MASQOMB)) SCAL (SURF0 POIN PROC PO1) ;
  25057. VAL3 = EXTR (FLU0 * (TAB1.<MASQOMB)) SCAL (SURF0 POIN PROC PO2) ;
  25058.  
  25059. SI (((VAL0 >EG 0.89999) ET (VAL0 &lt;EG 0.90001)) ET ((VAL1 >EG 0.47202) ET (VAL1 &lt;EG 0.47204)) ET ((VAL2 >EG 0.44973) ET (VAL2 &lt;EG 0.44975)) ET ((VAL3 >EG -0.00001) ET (VAL3 &lt;EG 0.00001)));
  25060. MESS 'RESULTAT CORRECT';
  25061. SINON ;
  25062. MESS 'RESULTAT INCORRECT';
  25063. erreur 5 ;
  25064. FINSI ;
  25065.  
  25066.  
  25067. *OPTI DONN 5 ;
  25068. FIN ;
  25069.  
  25070.  
  25071.  
  25072.  
  25073.  
  25074.  
  25075.  
  25076.  
  25077.  
  25078.  
  25079.  
  25080.  
  25081.  
  25082.  
  25083.  
  25084.  
  25085.  
  25086.  
  25087.  
  25088.  
  25089.  
  25090.  
  25091.  

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