Télécharger tokaflu.dgibi

Retour à la liste

Numérotation des lignes :

  1. * fichier : tokaflu.dgibi
  2. OPTI ECHO 0;
  3. graph = faux;
  4. **** @ACBLM
  5. DEBPROC @ACBLM VXL*CHPOINT VYL*CHPOINT VZL*CHPOINT TAB1*TABLE ;
  6. *
  7. ********************************************************************
  8. * Procedure de changement de base. On passe de la base cartesienne *
  9. * locale de l'objet modelise a la base cartesienne du maillage. L' *
  10. * axe Y de la base locale est dirige du point de tangence vers le *
  11. * centre du plasma. Alain MOAL (juillet-aout 1995) *
  12. ********************************************************************
  13. *
  14. *--------------- VARIABLES D'ENTREE :
  15. CP = TAB1.'CENTRE_PLASMA' ;
  16. PTG = TAB1.'PT_TGPLASMA' ;
  17. SI ((VALEUR DIME) EGA 2) ;
  18. SI (EXISTE TAB1 <PLAN) ;
  19. IPLAN = TAB1.<PLAN ;
  20. SINON ;
  21. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  22. FINSI ;
  23. FINSI ;
  24. *------------------------------------
  25. *
  26. VECT0 = CP MOINS PTG ;
  27. VX = COOR 1 VECT0 ;
  28. VY = COOR 2 VECT0 ;
  29. *
  30. *---- calcul de l'angle de rotation dans le plan XY
  31. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  32. ANG1 = 0. ;
  33. SINON ;
  34. ANG1 = -1.* (ATG VX VY) ;
  35. FINSI ;
  36. *
  37. SI ((VALEUR DIME) EGA 2) ;
  38. SI (EGA IPLAN 'PHICONS');
  39. * ---- Coupe 2D a Phi constant
  40. VXL1 = VZL ;
  41. VYL1 = VYL ;
  42. VZL1 = VXL * (-1.);
  43. * ---- rotation
  44. VXM = VXL1 * (COS ANG1) + (VYL1 * (-1.) * (SIN ANG1));
  45. VYM = VXL1 * (SIN ANG1) + (VYL1 * (COS ANG1)) ;
  46. VZM = VZL1 ;
  47. FINSI ;
  48. SI (EGA IPLAN 'THETACONS');
  49. * ---- Coupe 2D a Theta constant
  50. * ---- rotation
  51. VXM = VXL * (COS ANG1) + (VYL * (-1.) * (SIN ANG1)) ;
  52. VYM = VXL * (SIN ANG1) + (VYL * (COS ANG1)) ;
  53. VZM = VZL ;
  54. FINSI;
  55. SINON ;
  56. VZ = COOR 3 VECT0 ;
  57. *
  58. * ---- calcul de l'angle de rotation dans le plan Y1Z1
  59. VX1 = VX * (COS ANG1) + (VY * (SIN ANG1)) ;
  60. VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1)) ;
  61. VZ1 = VZ ;
  62. *
  63. SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
  64. ANG2 = 0. ;
  65. SINON ;
  66. ANG2 = ATG VZ1 VY1 ;
  67. FINSI ;
  68. *
  69. * ---- rotations
  70. VXL1 = VXL ;
  71. VYL1 = VYL * (COS ANG2) + (VZL * (-1.) * (SIN ANG2));
  72. VZL1 = VYL * (SIN ANG2) + (VZL * (COS ANG2)) ;
  73. *
  74. VXM = VXL1 * (COS ANG1) + (VYL1 * (-1.) * (SIN ANG1)) ;
  75. VYM = VXL1 * (SIN ANG1) + (VYL1 * (COS ANG1)) ;
  76. VZM = VZL1 ;
  77. FINSI ;
  78. FINPROC VXM VYM VZM ;
  79. **** @ACBML
  80. DEBPROC @ACBML VXM*CHPOINT VYM*CHPOINT VZM*CHPOINT TAB1*TABLE ;
  81. *
  82. **********************************************************************
  83. * Procedure de changement de base. On passe de la base cartesienne *
  84. * du maillage a la base cartesienne locale de l'objet modelise. L' *
  85. * axe Y est dirige du point de tangence vers le centre du plasma. *
  86. * Alain MOAL (juillet-aout 1995) *
  87. **********************************************************************
  88. *
  89. *--------------- VARIABLES D'ENTREE :
  90. CP = TAB1.'CENTRE_PLASMA' ;
  91. PTG = TAB1.'PT_TGPLASMA' ;
  92. SI ((VALEUR DIME) EGA 2) ;
  93. SI (EXISTE TAB1 <PLAN) ;
  94. IPLAN = TAB1.<PLAN ;
  95. SINON ;
  96. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  97. FINSI ;
  98. FINSI ;
  99. *------------------------------------
  100. *
  101. VECT0 = CP MOINS PTG ;
  102. VX = COOR 1 VECT0 ;
  103. VY = COOR 2 VECT0 ;
  104. *
  105. *---- calcul de l'angle de rotation dans le plan XY
  106. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  107. ANG1 = 0. ;
  108. SINON ;
  109. ANG1 = -1.* (ATG VX VY) ;
  110. FINSI ;
  111. *
  112. SI ((VALEUR DIME) EGA 2) ;
  113. * ---- rotation pour aligner l'axe Y avec VECT0
  114. SI (EGA IPLAN 'PHICONS');
  115. * ---- Coupe 2D a Phi constant
  116. VXL1 = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  117. VYL1 = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  118. VZL1 = VZM ;
  119. * ---- Coupe 2D a Phi constant
  120. VXL = VZL1 ;
  121. VYL = VYL1 ;
  122. VZL = VXL1 * (-1.);
  123. FINSI ;
  124. SI (EGA IPLAN 'THETACONS');
  125. * ---- Coupe 2D a Theta constant
  126. * ---- rotation
  127. VXL = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  128. VYL = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  129. VZL = VZM ;
  130. FINSI ;
  131. *
  132. SINON ;
  133. VZ = COOR 3 VECT0 ;
  134. * ---- rotation pour aligner l'axe Y avec VECT0
  135. VXM1 = VXM * (COS ANG1) + (VYM * (SIN ANG1));
  136. VYM1 = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
  137. VZM1 = VZM ;
  138. *
  139. VX1 = VX * (COS ANG1) + (VY * (SIN ANG1)) ;
  140. VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1)) ;
  141. VZ1 = VZ ;
  142. *
  143. * ---- calcul de l'angle de rotation dans le plan Y1Z1
  144. SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
  145. ANG2 = 0. ;
  146. SINON ;
  147. ANG2 = ATG VZ1 VY1 ;
  148. FINSI ;
  149. *
  150. VXL = VXM1 ;
  151. VYL = VYM1 * (COS ANG2) + (VZM1 * (SIN ANG2));
  152. VZL = VYM1 * (-1.) * (SIN ANG2) + (VZM1 * (COS ANG2));
  153. *
  154. FINSI ;
  155. *MESS '>>>> @CBMLV' ; LIST VXL ; LIST VYL ; LIST VZL ;
  156. FINPROC VXL VYL VZL ;
  157.  
  158. **** @ACRLM
  159. DEBPROC @ACRLM XL*CHPOINT YL*CHPOINT ZL*CHPOINT TAB1*TABLE ;
  160. *
  161. *******************************************************************
  162. * Procedure de changement de repere. On passe du repere cartesien *
  163. * local de l'objet modelise au repere cartesien du maillage. Le *
  164. * point de tangence au plasma est l'origine du repere local et *
  165. * l'axe Y est dirige vers le centre du plasma. *
  166. * Alain MOAL (juillet-aout 1995) *
  167. *******************************************************************
  168. *
  169. *--------------- VARIABLES D'ENTREE :
  170. CP = TAB1.'CENTRE_PLASMA' ;
  171. PTG = TAB1.'PT_TGPLASMA' ;
  172. SI ((VALEUR DIME) EGA 2) ;
  173. SI (EXISTE TAB1 <PLAN) ;
  174. IPLAN = TAB1.<PLAN ;
  175. SINON ;
  176. ERRE '>>>> TAB1.<PLAN n existe pas' ;
  177. FINSI ;
  178. FINSI ;
  179. *------------------------------------
  180. *
  181. VECT0 = CP MOINS PTG ;
  182. VX = COOR 1 VECT0 ;
  183. VY = COOR 2 VECT0 ;
  184. *
  185. *---- calcul de l'angle de rotation dans le plan XY
  186. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  187. ANG1 = 0. ;
  188. SINON ;
  189. ANG1 = -1.* (ATG VX VY) ;
  190. FINSI ;
  191. *
  192. XPTG = COOR 1 PTG ;
  193. YPTG = COOR 2 PTG ;
  194. *
  195. SI ((VALEUR DIME) EGA 2) ;
  196. SI (EGA IPLAN 'PHICONS');
  197. * ---- Coupe 2D a Phi constant
  198. XL = ZL ;
  199. ZL = ZL * 0.;
  200. * ---- rotation
  201. XL1 = XL * (COS ANG1) + (YL * (-1.) * (SIN ANG1));
  202. YL1 = XL * (SIN ANG1) + (YL * (COS ANG1));
  203. FINSI;
  204. SI (EGA IPLAN 'THETACONS');
  205. * ---- Coupe 2D a Theta constant
  206. * ---- rotation
  207. XL1 = XL * (COS ANG1) + (YL * (-1.) * (SIN ANG1));
  208. YL1 = XL * (SIN ANG1) + (YL * (COS ANG1));
  209. FINSI;
  210. * ---- changement d'origine du repere
  211. XM = XL1 + XPTG ;
  212. YM = YL1 + YPTG ;
  213. ZM = YL1 * 0. ;
  214. SINON ;
  215. VZ = COOR 3 VECT0 ;
  216. ZPTG = COOR 3 PTG ;
  217. *
  218. * ---- calcul de l'angle de rotation dans le plan Y1Z1
  219. VX1 = VX * (COS ANG1) + (VY * (SIN ANG1)) ;
  220. VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1)) ;
  221. VZ1 = VZ ;
  222. *
  223. SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
  224. ANG2 = 0. ;
  225. SINON ;
  226. ANG2 = ATG VZ1 VY1 ;
  227. FINSI ;
  228. *
  229. * ---- rotations
  230. XL1 = XL ;
  231. YL1 = YL * (COS ANG2) + (ZL * (-1.) * (SIN ANG2)) ;
  232. ZL1 = YL * (SIN ANG2) + (ZL * (COS ANG2)) ;
  233. *
  234. XL2 = XL1 * (COS ANG1) + (YL1 * (-1.) * (SIN ANG1)) ;
  235. YL2 = XL1 * (SIN ANG1) + (YL1 * (COS ANG1)) ;
  236. ZL2 = ZL1 ;
  237. *
  238. * ---- changement d'origine du repere
  239. XM = XL2 + XPTG ;
  240. YM = YL2 + YPTG ;
  241. ZM = ZL2 + ZPTG ;
  242. FINSI ;
  243. FINPROC XM YM ZM ;
  244. **** @ACRML
  245. DEBPROC @ACRML XM*CHPOINT YM*CHPOINT ZM*CHPOINT TAB1*TABLE ;
  246. *
  247. *******************************************************************
  248. * Procedure de changement de repere. On passe du repere cartesien *
  249. * du maillage au repere cartesien local de l'objet modelise. Le *
  250. * point de tangence au plasma est l'origine de ce repere et l'axe *
  251. * l'axe Y final est dirige vers le centre du plasma. *
  252. * en 3D l'axe x initial doit etre l'axe toroidal *
  253. * en 2D cas PHICONS l'axe Z initial est l'axe toroidal *
  254. * en 2D cas THETACONS l'axe x initial est l'axe toroidal *
  255. * Alain MOAL (juillet-aout 1995) *
  256. *******************************************************************
  257. *
  258. *--------------- VARIABLES D'ENTREE :
  259. CP = TAB1.'CENTRE_PLASMA' ;
  260. PTG = TAB1.'PT_TGPLASMA' ;
  261. SI ((VALEUR DIME) EGA 2) ;
  262. SI (EXISTE TAB1 <PLAN) ;
  263. IPLAN = TAB1.<PLAN ;
  264. SINON ;
  265. ERRE '>>>> @CRMLC : TAB1.<PLAN n existe pas' ;
  266. FINSI ;
  267. FINSI ;
  268. *------------------------------------
  269. *
  270. VECT0 = CP MOINS PTG ;
  271. VX = COOR 1 VECT0 ;
  272. VY = COOR 2 VECT0 ;
  273. *
  274. *---- calcul de l'angle de rotation dans le plan XY
  275. SI ((VX EGA 0.) ET (VY EGA 0.)) ;
  276. ANG1 = 0. ;
  277. SINON ;
  278. ANG1 = -1.* (ATG VX VY) ;
  279. FINSI ;
  280. *
  281. XPTG = COOR 1 PTG ;
  282. YPTG = COOR 2 PTG ;
  283. *
  284. SI ((VALEUR DIME) EGA 2) ;
  285. * ---- changement d'origine du repere
  286. XM1 = XM - XPTG ;
  287. YM1 = YM - YPTG ;
  288. * ---- rotation pour aligner l'axe Y avec VECT0
  289. SI (EGA IPLAN 'PHICONS');
  290. * ---- Coupe 2D a Phi constant
  291. XL = XM1 * (COS ANG1) + (YM1 * (SIN ANG1));
  292. YL = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1));
  293. ZL = XM * 0. ;
  294. *
  295. ZL = XL ;
  296. XL = XL * 0.;
  297. FINSI;
  298. SI (EGA IPLAN 'THETACONS');
  299. * ---- Coupe 2D a Theta constant
  300. XL = XM1 * (COS ANG1) + (YM1 * (SIN ANG1));
  301. YL = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1));
  302. ZL = XM * 0. ;
  303. FINSI ;
  304. *
  305. SINON ;
  306. VZ = COOR 3 VECT0 ;
  307. ZPTG = COOR 3 PTG ;
  308. * ---- changement d'origine du repere
  309. XM1 = XM - XPTG ;
  310. YM1 = YM - YPTG ;
  311. ZM1 = ZM - ZPTG ;
  312. * ---- rotation pour aligner l'axe Y avec VECT0
  313. XM2 = XM1 * (COS ANG1) + (YM1 * (SIN ANG1)) ;
  314. YM2 = XM1 * (-1.) * (SIN ANG1) + (YM1 * (COS ANG1)) ;
  315. ZM2 = ZM1 ;
  316. *
  317. VX1 = VX * (COS ANG1) + (VY * (SIN ANG1)) ;
  318. VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1)) ;
  319. VZ1 = VZ ;
  320. *
  321. * ---- calcul de l'angle de rotation dans le plan Y1Z1
  322. SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
  323. ANG2 = 0. ;
  324. SINON ;
  325. ANG2 = ATG VZ1 VY1 ;
  326. FINSI ;
  327. *
  328. XL = XM2 ;
  329. YL = YM2 * (COS ANG2) + (ZM2 * (SIN ANG2)) ;
  330. ZL = YM2 * (-1.) * (SIN ANG2) + (ZM2 * (COS ANG2)) ;
  331. *
  332. FINSI ;
  333. *MESS '>>>> @CRMLC : XL' ; LIST XL ; LIST YL ; LIST ZL ;
  334. FINPROC XL YL ZL ;
  335.  
  336. **** @AMPLI
  337. DEBPROC @AMPLI XV*CHPOINT YV*CHPOINT ZV*CHPOINT VALDIM*ENTIER MAIL0*MAILLAGE ;
  338. *
  339. *************************************************************
  340. * Procedure d'adaptation du facteur d'amplification utilise *
  341. * pour visualiser un champ de vecteur sur une geometrie. *
  342. * Alain MOAL (juillet 1995) *
  343. *************************************************************
  344. *
  345. XM = COOR 1 MAIL0 ;
  346. YM = COOR 2 MAIL0 ;
  347. SI (VALDIM EGA 2) ;
  348. ZM = XM * 0. ;
  349. SINON ;
  350. ZM = COOR 3 MAIL0 ;
  351. FINSI ;
  352. *
  353. *---- norme du vecteur
  354. VECNORM = ((XV * XV) + (YV * YV) + (ZV * ZV))**0.5 ;
  355. *
  356. *---- calcul d'une longueur caracteristique du maillage
  357. LONGCAR1 = ABS ((MAXI XM) - (MINI XM)) ;
  358. LONGCAR2 = ABS ((MAXI YM) - (MINI YM)) ;
  359. LONGCAR3 = ABS ((MAXI ZM) - (MINI ZM)) ;
  360. *
  361. SI (VALDIM EGA 2) ;
  362. LONGCAR = MINI (PROG LONGCAR1 LONGCAR2) ;
  363. SINON ;
  364. LONGCAR = MINI (PROG LONGCAR1 LONGCAR2 LONGCAR3) ;
  365. FINSI ;
  366. *
  367. AMPLI0 = LONGCAR / (MAXI VECNORM) / 10.;
  368. *
  369. FINPROC AMPLI0 ;
  370. **** @ANADES
  371.  
  372. DEBPROC @ANADES TAB1*TABLE ;
  373. *
  374. *************************************************
  375. * Procedure (inspiree de @ANALY) permettant de *
  376. * descendre les lignes de champ et de calculer *
  377. * avec une methode analytique exacte les points *
  378. * d'intersection sur le plan de reference pour *
  379. * recuperer les valeurs du flux normalise. *
  380. * Alain MOAL (Fevrier 2001) *
  381. *************************************************
  382. *
  383. MESS '---------------------------------> calling @ANADES';
  384. *
  385. *--------------- VARIABLES D'ENTREE :
  386. S_OMBRE = TAB1.LFLUX_EXTE ;
  387. S_OMBRAN = TAB1.<MAILLAGE_FN ;
  388. CHSIGN1 = TAB1.<CHAMP_SIGNE ;
  389. PASB2 = TAB1.<LONGUEUR_PAS_AVEC_TEST ;
  390. DMAX2 = TAB1.<DISTANCE_AVEC_TEST ;
  391. NBPAS2 = TAB1.<NOMBRE_PAS_AVEC_TEST ;
  392. PASB1 = TAB1.<LONGUEUR_PAS_SANS_TEST ;
  393. DMAX1 = TAB1.<DISTANCE_SANS_TEST ;
  394. NBPAS1 = TAB1.<NOMBRE_PAS_SANS_TEST ;
  395. TOL1 = 1.e-9 ;
  396. *------------------------------------
  397. *
  398. * --- PASSAGE EN TRI3 POUR LA PROCEDURE @INTSEC
  399. si (DIME(S_OMBRAN ELEM 'TYPE') EGA 2) ;
  400. stri3 = elem s_ombran tri3 ;
  401. squa4 = elem s_ombran qua4 ;
  402. squtri3 = chan squa4 tri3 ;
  403. s_ombra2 = squtri3 et stri3 ;
  404. sinon ;
  405. s_ombra2 = chan s_ombran tri3 ;
  406. finsi ;
  407. *
  408. * --- CONSTRUCTION DU MAILLAGE DES POINTS A SUIVRE
  409. MAILPTS = MANU POI1 ((chan s_ombre poi1) poin init) ;
  410. TABPTS1 = table ;
  411. TABPTS1 . 1 = (chan s_ombre poi1) poin init ;
  412. npts = 1 ;
  413. tablig1 = table ;
  414.  
  415. * --- CREATION DES 3 CHMELEM DE COORDONNEES AUX ELEMENTS
  416. TAB1.<MAILLAGE = S_OMBRA2 ;
  417. *AM*27/01/04 @RMXYZ TAB1 ;
  418. @RMCOORO TAB1 ;
  419. * --- CALCUL DES NORMALES AUX ELEMENTS SUR LE MAILLAGE OMBRANT
  420. *AM*27/01/04 @AMNORM TAB1 ;
  421. @RMNORM TAB1 ;
  422. * ---- Flux normalise sur le maillage ombrant
  423. @RMFLUN TAB1 ;
  424.  
  425. MESS ' ';
  426. MESS 'WITHOUT TEST';
  427. MESS 'Distance covered :' DMAX1 ;
  428. MESS 'Step :' PASB1 ;
  429. MESS 'Iterations number :' NBPAS1 ;
  430. MESS ' ';
  431. MESS 'WITH TEST';
  432. MESS 'Distance covered :' DMAX2 ;
  433. MESS 'Step :' PASB2 ;
  434. MESS 'Iterations number :' NBPAS2 ;
  435. MESS ' ' ;
  436.  
  437. * --- initialisation du pas
  438. I1 = 0 ;
  439. * ---initialisation de la distance de connexion
  440. CHDIST = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
  441. * --- initialisation du flux normalise
  442. CHFNORM = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
  443. * --- initialisation du maillage ou on va tester les intersections
  444. s_ombre2 = s_ombre ;
  445. * --- initialisation du maillage ou on va remonter les lignes
  446. mailcou = s_ombre2 et mailpts ;
  447. * ---- initialisation des distances
  448. LCOURAN1 = 0. ;
  449. LMAX1 = 0. ;
  450. * ---- coordonnees
  451. XG_OLD = COOR 1 mailcou ;
  452. YG_OLD = COOR 2 mailcou ;
  453. ZG_OLD = COOR 3 mailcou ;
  454. *
  455. * --- initialisation des lignes de champ remontees
  456. REPETER BOUPTS1 NPTS ;
  457. tablig1 . &BOUPTS1 = TABPTS1 . &BOUPTS1 ;
  458. FIN BOUPTS1 ;
  459.  
  460. *--------------------------------------------------------------
  461. *
  462. * DEBUT DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  463. *
  464. *--------------------------------------------------------------
  465. *
  466. * ----- sans test d'interception
  467. PASB0 = PASB1 ;
  468. * increment de la distance de connexion (= PAS tant qu'il n'y a pas
  469. * d'intersection)
  470.  
  471. chdist9 = manu chpo s_ombre2 1 scal pasb0 ;
  472. chfn9 = manu chpo s_ombre2 1 scal 0. ;
  473. *
  474. * initialisation a 0 des deplacements
  475. DEPX0 = XG_OLD * 0. ;
  476. DEPY0 = YG_OLD * 0. ;
  477. DEPZ0 = ZG_OLD * 0. ;
  478. DEPX0 = NOMC UX DEPX0 NATURE DIFFUS ;
  479. DEPY0 = NOMC UY DEPY0 NATURE DIFFUS ;
  480. DEPZ0 = NOMC UZ DEPZ0 NATURE DIFFUS ;
  481. TAB1.<DEPLACEMENT = DEPX0 ET DEPY0 ET DEPZ0 ;
  482.  
  483. SI (NBPAS1 NEG 0) ;
  484. MESS 'WITHOUT INTERCEPTION TEST';
  485. REPETER BOUCLE1 NBPAS1 ;
  486. I1 = I1 + 1 ;
  487. LCOURAN1 = LCOURAN1 + PASB0 ;
  488. MESS ' ';
  489. MESS 'ITERATION : ' I1 'distance covered' LCOURAN1 ;
  490.  
  491. * ---- Appel de la procedure de descente des lignes de champ
  492. XG_NEW YG_NEW ZG_NEW DEP0 = @descend XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1;
  493. FORM DEP0 ;
  494. TAB1.<DEPLACEMENT = TAB1.<DEPLACEMENT + DEP0 ;
  495.  
  496. * --- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  497. chdist = chdist + CHDIST9 ;
  498.  
  499. * --- construction des lignes de champ remontees
  500. * --- Extraction des coordonnees des points a remonter
  501. * xmailpt2 = redu XG_NEW mailpts ;
  502. * ymailpt2 = redu YG_NEW mailpts ;
  503. * zmailpt2 = redu ZG_NEW mailpts ;
  504. *
  505. * --- Construction des lignes de remontee
  506. * repeter boupts2 npts ;
  507. * xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts2) ;
  508. * yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts2) ;
  509. * zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts2) ;
  510. * prem2 = xprem2 yprem2 zprem2 ;
  511. * tablig1.&boupts2 = (tablig1 . &boupts2) d 1 prem2 ;
  512. * fin boupts2 ;
  513.  
  514. * --- actualisation des champs de coordonnees pour iteration suivante
  515. XG_OLD = XG_NEW ;
  516. YG_OLD = YG_NEW ;
  517. ZG_OLD = ZG_NEW ;
  518. MENA ;
  519. FIN BOUCLE1 ;
  520. FINSI ;
  521.  
  522. MESS 'WITH INTERCEPTION TEST';
  523.  
  524. PASB0 = PASB2 ;
  525. s_ombreP = chan s_ombre poi1 ;
  526. s_ombre2 = chan s_ombre poi1 ;
  527. mailcou = s_ombre2 et mailpts ;
  528.  
  529. I2 = 0 ;
  530. I3 = 0 ;
  531. REPETER BOUCLE2 NBPAS2 ;
  532. I1 = I1 + 1 ;
  533. I3 = I3 + 1 ;
  534. SI (NBNO s_ombre2 > 0) ;
  535. * ---- si il reste des noeuds non encore intersectes
  536. LCOURAN1 = LCOURAN1 + PASB0 ;
  537. MESS ' ';
  538. MESS 'ITERATION : ' I1 'distance covered' LCOURAN1 ;
  539.  
  540. * ---- Appel de la procedure de descente des lignes de champ
  541. XG_NEW YG_NEW ZG_NEW DEP0 = @DESCEND XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1 ;
  542.  
  543. * ---- test sur les eventuels noeuds interceptes
  544. * ---- Les CHPO sont reduits sur les points de s_ombre
  545. * ---- qui n'ont pas encore ete intersectes : s_ombre2
  546. XG_OLD_R = REDU XG_OLD S_OMBRE2 ;
  547. YG_OLD_R = REDU YG_OLD S_OMBRE2 ;
  548. ZG_OLD_R = REDU ZG_OLD S_OMBRE2 ;
  549.  
  550. XG_NEW_R = REDU XG_NEW S_OMBRE2 ;
  551. YG_NEW_R = REDU YG_NEW S_OMBRE2 ;
  552. ZG_NEW_R = REDU ZG_NEW S_OMBRE2 ;
  553.  
  554. XG_OLD_R = NOMC X XG_OLD_R 'NATU' 'DIFFUS' ;
  555. YG_OLD_R = NOMC Y YG_OLD_R 'NATU' 'DIFFUS' ;
  556. ZG_OLD_R = NOMC Z ZG_OLD_R 'NATU' 'DIFFUS' ;
  557.  
  558. CH_OLD = XG_OLD_R ET YG_OLD_R ET ZG_OLD_R ;
  559.  
  560. XG_NEW_R = NOMC X XG_NEW_R 'NATU' 'DIFFUS' ;
  561. YG_NEW_R = NOMC Y YG_NEW_R 'NATU' 'DIFFUS' ;
  562. ZG_NEW_R = NOMC Z ZG_NEW_R 'NATU' 'DIFFUS' ;
  563.  
  564. CH_NEW = XG_NEW_R ET YG_NEW_R ET ZG_NEW_R ;
  565. *
  566. * ---- Test d'interception
  567. * CHDIST9 MINTER CHFN9 DEPMP1 = @INTSEC CH_OLD CH_NEW TOL1 TAB1 ;
  568. CHDIST9 MINTER CHFN9 DEPMP1 = IJET CH_OLD CH_NEW TOL1 TAB1 ;
  569.  
  570. * CHDIST9 = CHPO CONTENANT PAS POUR LES NOEUDS INTERSECTES
  571. * ET D(M,PT_REMONTE) SINON
  572.  
  573. * S_OMBRE2 contient les noeuds de s_ombre qui n'ont
  574. * pas ete intesectes
  575. * s_ombre0 contient les noeuds qui ont deja ete intersectes
  576. * minter contient les noeuds qui viennent d'etre intersectes
  577. s_ombre0 = diff s_ombreP s_ombre2 ;
  578. s_ombre2 = diff s_ombre2 MINTER ;
  579.  
  580. TITRE 'TEST : POINTS INTERCEPTES (BLANC ET JAUNE)' ;
  581. TRAC ((s_ombre2 coul roug) et MINTER et (s_ombre0 COUL JAUNE) et TAB1.<GRILLE_B et TAB1.<MAILLAGE_FN) ;
  582. *
  583. DEP01 = REDU DEP0 s_ombre2 ;
  584. DEP02 = MANU CHPO s_ombre0 3 UX 0. UY 0. UZ 0. NATURE DIFFUS ;
  585. SI ((NBNO MINTER) > 0) ;
  586. DEP0 = DEP01 ET DEP02 ET DEPMP1 ;
  587. SINON ;
  588. DEP0 = DEP01 ET DEP02 ;
  589. FINSI ;
  590.  
  591. FORM DEP0 ;
  592.  
  593. * ---- Test
  594. * i9 = 0 ;
  595. * repeter bouc01 (nbno (EXTR DEP0 'MAIL')) ;
  596. * i9 = i9 + 1 ;
  597. * list ((EXTR DEP0 'MAIL') poin i9) ;
  598. * list (redu CHFN9 ((EXTR DEP0 'MAIL') poin i9)) ;
  599. * fin bouc01 ;
  600. * TITRE 'TEST : NOEUDS SUPPORTS DU DEPLACEMENT';
  601. * TRAC (EXTR DEP0 'MAIL') ;
  602. * ---- Fin test
  603.  
  604. TAB1.<DEPLACEMENT = TAB1.<DEPLACEMENT + DEP0 ;
  605.  
  606. * ---- actualisation du maillage de descente
  607. mailcou = s_ombre2 et mailpts ;
  608.  
  609. CHSIGN1 = REDU CHSIGN1 mailcou ;
  610.  
  611. SI ((NBNO MINTER) > 0) ;
  612. mess (NBNO MINTER) 'intercepted points';
  613. LMAX1 = LCOURAN1 - pasb0 + (mini CHDIST9) ;
  614. FINSI ;
  615.  
  616. * ---- Distances parcourues avant interception
  617. chdist = chdist + CHDIST9 ;
  618. chfnorm = chfnorm + chfn9 ;
  619. mess 'mini maxi connection distance (m)' (mini (prog lmax1 (mini chdist))) lmax1 ;
  620. * list chfnorm ;
  621.  
  622. * --- construction des lignes de champ remontees
  623. * --- Extraction des coordonnees des points a remonter
  624. * xmailpt2 = redu XG_NEW mailpts ;
  625. * ymailpt2 = redu YG_NEW mailpts ;
  626. * zmailpt2 = redu ZG_NEW mailpts ;
  627. *
  628. * --- Construction des lignes de descentes
  629. * repeter boupts3 npts ;
  630. * xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts3) ;
  631. * yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts3) ;
  632. * zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts3) ;
  633. * prem2 = xprem2 yprem2 zprem2 ;
  634. * tablig1 . &boupts3 = (tablig1 . &boupts3) d 1 prem2 ;
  635. * fin boupts3 ;
  636.  
  637. * --- actualisation des champs de coordonnees pour iteration suivante
  638. XG_OLD = redu XG_NEW mailcou;
  639. YG_OLD = redu YG_NEW mailcou;
  640. ZG_OLD = redu ZG_NEW mailcou;
  641. MENA ;
  642. sinon ;
  643. SI (I2 EGA 0) ;
  644. MESS ' ';
  645. MESS 'ALL POINTS ARE INTERCEPTED' ;
  646. MESS ' ';
  647. I2 = I1 ;
  648. FINSI ;
  649. finsi ;
  650. FIN BOUCLE2 ;
  651.  
  652. *--- Sorties dans TAB1
  653. TAB1.<CHAMP_DISTANCE = CHDIST ;
  654. TAB1.<LONGUEUR_CONNEXION_MAX = LMAX1 ;
  655. TAB1.<LONGUEUR_PARCOURUE = LCOURAN1 ;
  656.  
  657. *si (exis tab1 <remontee) ;
  658. * tab1 . <remontee . <ligne = tablig1 ;
  659. *finsi ;
  660.  
  661. MESS '---------------------------------> exiting @ANADES';
  662. FINPROC chfnorm ;
  663.  
  664. **** @ANAJET
  665.  
  666. DEBPROC @ANAJET TAB1*TABLE ;
  667.  
  668. MESS '---------------------------------> calling @ANAJET';
  669. MESS 'METHODE ANALYTIQUE' ;
  670. *
  671. *--------------- VARIABLES D'ENTREE :
  672. *
  673.  
  674. S_OMBRE = TAB1.<S_OMBRE ;
  675. S_OMBRAN = TAB1.<S_OMBRANT ;
  676. IMETHOD = TAB1.<METHODE_REMONTEE ;
  677. CHSIGN1 = TAB1.<CHSIGN ;
  678.  
  679.  
  680. si (exis tab1 <remontee) ;
  681. TABPTS1 = TAB1.<REMONTEE.<POINT ;
  682. tablig1 = table ;
  683. finsi ;
  684.  
  685. PASB2 = TAB1.<PAS_AVEC_TEST ;
  686. DMAX2 = TAB1.<DIST_AVEC_TEST ;
  687. NBPAS2 = TAB1.<NBPAS2 ;
  688.  
  689. SI (EXIS TAB1 <PAS_SANS_TEST) ;
  690. PASB1 = TAB1.<PAS_SANS_TEST ;
  691. DMAX1 = TAB1.<DIST_SANS_TEST ;
  692. NBPAS1 = TAB1.<NBPAS1 ;
  693. FINSI ;
  694.  
  695.  
  696. SI (EXIS TAB1 <TOLERANCE) ;
  697. TOL1 = TAB1.<TOLERANCE ;
  698. SINON ;
  699. TOL1 = 1.e-9 ;
  700. FINSI ;
  701.  
  702. *
  703. * --- PASSAGE EN TRI3 POUR LA PROC @INTERC
  704. *
  705.  
  706. LMOT = s_ombran ELEM 'TYPE' ;
  707. ntyp = dime LMOT ;
  708. si (ntyp ega 2) ;
  709. stri3 = elem s_ombran tri3 ;
  710. squa4 = elem s_ombran qua4 ;
  711. squtri3 = chan squa4 tri3 ;
  712. s_ombra2 = squtri3 et stri3 ;
  713. sinon ;
  714. s_ombra2 = chan s_ombran tri3 ;
  715. finsi ;
  716.  
  717.  
  718. * --- CONSTRUCTION DU MAILLAGE DES POINTS A REMONTER
  719. si (exis tab1 <remontee) ;
  720. MAILPTS = MANU POI1 TABPTS1 . 1 ;
  721. NPTS = DIME TABPTS1 ;
  722. REPETER BOUPTS1 (NPTS - 1) ;
  723. MAILPTS = MAILPTS ET TABPTS1 . (&BOUPTS1 + 1) ;
  724. FIN BOUPTS1 ;
  725. sinon ;
  726. * RM 15/06/2000 MAILPTS = MANU POI1 (s_ombre poin init) ;
  727. MAILPTS = MANU POI1 ((chan s_ombre poi1) poin init) ;
  728. TABPTS1 = table ;
  729. TABPTS1 . 1 = (chan s_ombre poi1) poin init ;
  730. npts = 1 ;
  731. tablig1 = table ;
  732. finsi ;
  733.  
  734.  
  735. si (non (tab1.<reprise)) ;
  736. * --- CREATION DES 3 CHMELEM DE COORDONNEES AUX ELEMENTS
  737. * --- Remarque : ces coordonnees seront exprimees dans le repere globale
  738. TAB1.<MAILLAGE = S_OMBRA2 ;
  739. *AM*27/01/04 si (non (exis tab1 <chamx1)) ;
  740. *AM*27/01/04 @AMCOORO TAB1 ;
  741. @RMCOORO TAB1 ;
  742. *AM*27/01/04 finsi ;
  743. * --- CALCUL DES NORMALES AUX ELEMENTS SUR LE MAILLAGE OMBRANT
  744. *AM*27/01/04 si (non (exis tab1 <cosx)) ;
  745. @RMNORM TAB1 ;
  746. *AM*27/01/04 finsi ;
  747. finsi ;
  748.  
  749.  
  750. *
  751. * --- Rappel des parametres de la procedure
  752. *
  753. MESS ' ';
  754. MESS '##################################################';
  755. MESS ' ';
  756. MESS '>@ANAJET> procedure OMBJET, Rappel des parametres de calcul ';
  757. MESS ' ';
  758.  
  759. si (tab1.<reprise) ;
  760. mess 'Reprise d un calcul';
  761. mess '-------------------';
  762. finsi ;
  763.  
  764. SI (IMETHOD EGA 1) ;
  765. METH = 'methode explicite des tangentes';
  766. FINSI ;
  767. SI (IMETHOD EGA 2) ;
  768. METH = 'methode moyenne des tangentes aux extremitee';
  769. FINSI ;
  770. SI (IMETHOD EGA 3) ;
  771. METH = 'methode du point milieu';
  772. FINSI ;
  773. SI (IMETHOD EGA 4) ;
  774. METH = 'methode de reprojection';
  775. FINSI ;
  776. MESS ' ';
  777.  
  778. SI (EXIS tab1 <PAS_SANS_TEST) ;
  779. MESS 'Calcul en deux parties :';
  780. MESS ' ';
  781. MESS 'SANS TEST';
  782. MESS 'Distance remontee :' DMAX1 ;
  783. MESS 'Pas pour la remontee :' PASB1 ;
  784. MESS 'Nombre d iterations :' NBPAS1 ;
  785. MESS ' ';
  786. MESS 'AVEC TEST';
  787. MESS 'Distance remontee :' DMAX2 ;
  788. MESS 'Pas pour la remontee :' PASB2 ;
  789. MESS 'Nombre d iterations :' NBPAS2 ;
  790. SINON ;
  791. MESS 'Calcul avec test systematique :';
  792. MESS 'Distance remontee :' DMAX2 ;
  793. MESS 'Pas de remontee :' PASB2 ;
  794. MESS 'Nombre d iterations :' NBPAS2 ;
  795. FINSI ;
  796. MESS ' ' ;
  797.  
  798. *
  799. *--------------------------------------------------------------
  800. *
  801. * INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  802. * --- CAS SANS REPRISE ---
  803. *--------------------------------------------------------------
  804. si (non (tab1.<reprise)) ;
  805. * --- initialisation du pas
  806. I1 = 0 ;
  807. * ---initialisation de la distance de connexion
  808. CHDIST = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
  809. * --- initialisation du maillage ou on va tester les intersections
  810. s_ombre2 = s_ombre ;
  811. * --- initialisation du maillage ou on va remonter les lignes
  812. mailcou = s_ombre2 et mailpts ;
  813. *---- initialisation des distances
  814. LCOURAN1 = 0. ;
  815. LMAX1 = 0. ;
  816. * ---- coordonnees dans le repere du maillage
  817. XM0 = COOR 1 mailcou ;
  818. YM0 = COOR 2 mailcou ;
  819. ZM0 = COOR 3 mailcou ;
  820. *---- Coordonnees dans le repere global du tore
  821. XG_OLD = XM0 ;
  822. YG_OLD = YM0 ;
  823. ZG_OLD = ZM0 ;
  824.  
  825. *
  826. * --- initialisation des lignes de champ remontees
  827. REPETER BOUPTS1 NPTS ;
  828. tablig1 . &BOUPTS1 = TABPTS1 . &BOUPTS1 ;
  829. FIN BOUPTS1 ;
  830.  
  831. sinon ;
  832. *
  833. *--------------------------------------------------------------
  834. *
  835. * INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  836. * --- CAS AVEC REPRISE ---
  837. *--------------------------------------------------------------
  838. * --- initialisation du pas
  839. I1 = tab1.<i_ombrage ;
  840. * --- initialisation de la distance de connexion
  841. CHDIST = tab1.<chdist;
  842. * --- initialisation du maillage ou on va tester les intersections
  843. s_ombre2 = tab1.<s_omb_non_inter ;
  844. * --- initialisation du maillage ou on va remonter les lignes
  845. mailcou = s_ombre2 et mailpts ;
  846.  
  847.  
  848. *---- initialisation des distances
  849. LCOURAN1 = maxi chdist ;
  850. LMAX1 = tab1.<CONNEXION_MAX ;
  851.  
  852. *---- Coordonnees dans le repere global du tore
  853. XG_OLD = exco X tab1.<CHCOOR0 ;
  854. YG_OLD = exco Y tab1.<CHCOOR0 ;
  855. ZG_OLD = exco Z tab1.<CHCOOR0 ;
  856. *
  857.  
  858. * --- initialisation des lignes de champ remontees
  859. si (exis tab1 <remontee) ;
  860. tablig1 = tab1.<remontee.<ligne ;
  861. sinon ;
  862. tablig1 . 1 = (TABPTS1 . 1) d 1 (TABPTS1.1 plus (0. 0. 0.));
  863. finsi ;
  864.  
  865. finsi ;
  866.  
  867. *--------------------------------------------------------------
  868. *
  869. * DEBUT DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  870. *
  871. *--------------------------------------------------------------
  872. *
  873. MESS ' ';
  874. MESS '##################################################';
  875. MESS ' ';
  876.  
  877. SI (EXIS TAB1 <DIST_SANS_TEST) ;
  878.  
  879. * ------------------ Boucle 1 on remonte sans test -------------------
  880. PASB0 = PASB1 ;
  881. * increment de la distance de connexion (= PAS tant qu'il n'y a pas
  882. * d'intersection)
  883. chdist9 = manu chpo s_ombre2 1 scal pasb0 ;
  884.  
  885. *
  886. * initialisation a 0 des deplacements
  887. DEPX0 = XG_OLD * 0. ;
  888. DEPY0 = YG_OLD * 0. ;
  889. DEPZ0 = ZG_OLD * 0. ;
  890. DEPX0 = NOMC UX DEPX0 NATURE DIFFUS ;
  891. DEPY0 = NOMC UY DEPY0 NATURE DIFFUS ;
  892. DEPZ0 = NOMC UZ DEPZ0 NATURE DIFFUS ;
  893. TAB1.<DEPLACE = DEPX0 ET DEPY0 ET DEPZ0 ;
  894.  
  895. MESS 'PREMIERE PARTIE DU CALCUL, SANS TEST D INTERSECTION';
  896. REPETER BOUCLE1 NBPAS1 ;
  897. I1 = I1 + 1 ;
  898. LCOURAN1 = LCOURAN1 + PASB0 ;
  899. MESS ' ';
  900. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  901.  
  902. * ---- Appel de la procedure de remontee des lignes de champ
  903. XG_NEW YG_NEW ZG_NEW DEP0 = @remojet XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1 ;
  904. FORM DEP0 ;
  905. TAB1.<DEPLACE = TAB1.<DEPLACE + DEP0 ;
  906. TITRE 'SANS TEST, ITERATION : 'I1 ;
  907. TRAC ((s_ombre2 coul roug) ET TAB1.<GRILLE_B ET TAB1.<S_OMBRANT) ;
  908.  
  909. *--- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  910. chdist = chdist + CHDIST9 ;
  911.  
  912.  
  913. *-----------------------------------------------------------------
  914. *--- construction des lignes de champ remontees
  915. * --- Extraction des coordonnees des points a remonter
  916. xmailpt1 = redu XG_NEW mailpts ;
  917. ymailpt1 = redu YG_NEW mailpts ;
  918. zmailpt1 = redu ZG_NEW mailpts ;
  919.  
  920. * --- Calcul des coordonnees des points a remonter dans le repere du maillage
  921. xmailpt2 = xmailpt1 ;
  922. ymailpt2 = ymailpt1 ;
  923. zmailpt2 = zmailpt1 ;
  924.  
  925. *
  926. * --- Construction des lignes de remontee
  927. repeter boupts2 npts ;
  928. xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts2) ;
  929. yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts2) ;
  930. zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts2) ;
  931. prem2 = xprem2 yprem2 zprem2 ;
  932. tablig1.&boupts2 = (tablig1 . &boupts2) d 1 prem2 ;
  933. fin boupts2 ;
  934. **-----------------------------------------------------------------
  935.  
  936.  
  937. * --- actualisation des champs de coordonnees pour iteration suivante
  938.  
  939. XG_OLD = XG_NEW ;
  940. YG_OLD = YG_NEW ;
  941. ZG_OLD = ZG_NEW ;
  942.  
  943. MENA ;
  944.  
  945. FIN BOUCLE1 ;
  946. * ------------------------ Fin de la boucle 1 ------------------------
  947. finsi ;
  948.  
  949.  
  950. MESS ' ';
  951. MESS '##################################################';
  952. MESS ' ';
  953.  
  954. MESS 'CALCUL AVEC TEST D INTERSECTION';
  955.  
  956. * ------------------ Boucle 2 on remonte avec test -------------------
  957. PASB0 = PASB2 ;
  958. si (non (tab1.<reprise)) ;
  959. s_ombre2 = chan s_ombre poi1 ;
  960. mailcou = s_ombre2 et mailpts ;
  961. finsi ;
  962. REPETER BOUCLE2 NBPAS2 ;
  963.  
  964. I1 = I1 + 1 ;
  965. LCOURAN1 = LCOURAN1 + PASB0 ;
  966. MESS ' ';
  967. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  968.  
  969. * ---- Appel de la procedure de remonter des lignes de champ
  970. XG_NEW YG_NEW ZG_NEW DEP0 = @remojet XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1 ;
  971. *---- ------test sur les eventuels noeuds interceptes -----------
  972. *---- seulement s'il reste des noeuds non encore intersectes ----
  973. si (nbno s_ombre2 > 0.) ;
  974.  
  975. * --- Les CHPO sont reduits sur les points de s_ombre
  976. * --- qui n'ont pas encore ete intersectes : s_ombre2
  977.  
  978. XG_OLD_R = REDU XG_OLD S_OMBRE2 ;
  979. YG_OLD_R = REDU YG_OLD S_OMBRE2 ;
  980. ZG_OLD_R = REDU ZG_OLD S_OMBRE2 ;
  981.  
  982. XG_NEW_R = REDU XG_NEW S_OMBRE2 ;
  983. YG_NEW_R = REDU YG_NEW S_OMBRE2 ;
  984. ZG_NEW_R = REDU ZG_NEW S_OMBRE2 ;
  985.  
  986.  
  987. XG_OLD_R = NOMC X XG_OLD_R 'NATU' 'DIFFUS' ;
  988. YG_OLD_R = NOMC Y YG_OLD_R 'NATU' 'DIFFUS' ;
  989. ZG_OLD_R = NOMC Z ZG_OLD_R 'NATU' 'DIFFUS' ;
  990.  
  991. CH_OLD = XG_OLD_R ET YG_OLD_R ET ZG_OLD_R ;
  992.  
  993.  
  994. XG_NEW_R = NOMC X XG_NEW_R 'NATU' 'DIFFUS' ;
  995. YG_NEW_R = NOMC Y YG_NEW_R 'NATU' 'DIFFUS' ;
  996. ZG_NEW_R = NOMC Z ZG_NEW_R 'NATU' 'DIFFUS' ;
  997.  
  998. CH_NEW = XG_NEW_R ET YG_NEW_R ET ZG_NEW_R ;
  999.  
  1000. *
  1001. * --- APPEL DE LA PROCEDURE DE CALCUL DES NOEUDS INTERSECTES
  1002. *
  1003. * CHDIST9 MINTER = @INTERC CH_OLD CH_NEW TOL1 TAB1 ;
  1004. CHDIST9 MINTER = ITRC CH_OLD CH_NEW TOL1 TAB1 ;
  1005.  
  1006. * CHDIST9 = CHPO CONTENANT PAS POUR LES NOEUDS INTERSECTES
  1007. * ET D(M,PT_REMONTE) SINON
  1008.  
  1009.  
  1010. * S_OMBRE2 contient les noeuds de s_ombre qui n'ont
  1011. * pas ete intesectes.
  1012. s_ombre2 = diff s_ombre2 MINTER ;
  1013.  
  1014. * actualisation du maillage de remontee
  1015. mailcou = s_ombre2 et mailpts ;
  1016.  
  1017. CHSIGN1 = REDU CHSIGN1 mailcou ;
  1018.  
  1019. SI ((NBNO MINTER) > 0) ;
  1020. mess 'nombre de noeuds intersectes ' (NBNO MINTER) ;
  1021. LMAX1 = LCOURAN1 - pasb0 + (mini CHDIST9) ;
  1022. FINSI ;
  1023.  
  1024. * --- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  1025. chdist = chdist + CHDIST9 ;
  1026. mess 'mini maxi dist connection en m' (mini (prog lmax1 (mini chdist))) lmax1 ;
  1027.  
  1028.  
  1029. finsi ;
  1030. * ------------------ fin du test d'interception ------------------
  1031.  
  1032.  
  1033.  
  1034. *-----------------------------------------------------------------
  1035. *--- construction des lignes de champ remontees
  1036. *--- Extraction des coordonnees des points a remonter
  1037. xmailpt1 = redu XG_NEW mailpts ;
  1038. ymailpt1 = redu YG_NEW mailpts ;
  1039. zmailpt1 = redu ZG_NEW mailpts ;
  1040.  
  1041. *--- Calcul des coordonnees des points a remonter dans le repere du maillage
  1042. xmailpt2 = xmailpt1 ;
  1043. ymailpt2 = ymailpt1 ;
  1044. zmailpt2 = zmailpt1 ;
  1045.  
  1046. *--- Construction des lignes de remontee
  1047. repeter boupts3 npts ;
  1048. xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts3) ;
  1049. yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts3) ;
  1050. zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts3) ;
  1051. prem2 = xprem2 yprem2 zprem2 ;
  1052. tablig1 . &boupts3 = (tablig1 . &boupts3) d 1 prem2 ;
  1053. fin boupts3 ;
  1054. *-----------------------------------------------------------------
  1055.  
  1056.  
  1057.  
  1058. * --- actualisation des champs de coordonnees pour iteration suivante
  1059.  
  1060. XG_OLD = redu XG_NEW mailcou;
  1061. YG_OLD = redu YG_NEW mailcou;
  1062. ZG_OLD = redu ZG_NEW mailcou;
  1063.  
  1064. MENA ;
  1065. FORM DEP0 ;
  1066. TAB1.<DEPLACE = TAB1.<DEPLACE + DEP0 ;
  1067. TITRE 'AVEC TEST, ITERATION : 'I1 ;
  1068. TRAC ((s_ombre2 coul roug) ET MINTER ET TAB1.<GRILLE_B ET TAB1.<S_OMBRANT) ;
  1069.  
  1070. FIN BOUCLE2 ;
  1071. * --------------------- Fin de la boucle 2 ----------------------
  1072.  
  1073.  
  1074. *--- Sorties dans TAB1
  1075.  
  1076. TAB1.<CHDIST = CHDIST ;
  1077. TAB1.<CONNEXION_MAX = LMAX1 ;
  1078. TAB1.<LONGUEUR_REMONTEE = LCOURAN1 ;
  1079.  
  1080. si (exis tab1 <remontee) ;
  1081. tab1 . <remontee . <ligne = tablig1 ;
  1082. finsi ;
  1083.  
  1084. *Sauvegardes pour reprise eventuelle
  1085. XG_OLD = nomc X XG_OLD nature discret ;
  1086. YG_OLD = nomc Y YG_OLD nature discret ;
  1087. ZG_OLD = nomc Z ZG_OLD nature discret ;
  1088. tab1.<CHCOOR0 = (XG_OLD et YG_OLD et ZG_OLD) ;
  1089. tab1.<s_omb_non_inter = s_ombre2 ;
  1090. tab1.<i_ombrage = i1 ;
  1091.  
  1092. MESS '---------------------------------> exiting @ANAJET';
  1093. FINPROC ;
  1094.  
  1095. **** @ANALY
  1096.  
  1097. DEBPROC @ANALY TAB1*TABLE ;
  1098.  
  1099. MESS '---------------------------------> calling @ANALY';
  1100. MESS 'METHODE ANALYTIQUE' ;
  1101. *
  1102. *--------------- VARIABLES D'ENTREE :
  1103. *
  1104.  
  1105. S_OMBRE = TAB1.<S_OMBRE ;
  1106. S_OMBRAN = TAB1.<S_OMBRANT ;
  1107. IMETHOD = TAB1.<METHODE_REMONTEE ;
  1108. CHSIGN1 = TAB1.<CHSIGN ;
  1109.  
  1110. TYPCAL = TAB1.<TYPE_CALCUL ;
  1111. RP = TAB1.<RP ;
  1112. RHO0 = TAB1.<RHO0 ;
  1113. RR = TAB1.<RR ;
  1114. HP = TAB1.<HP ;
  1115. EPS0 = TAB1.<EPS ;
  1116. COEFA = TAB1.<COEFA ;
  1117. COEFB = TAB1.<COEFB ;
  1118. COEFC = TAB1.<COEFC ;
  1119. NBOB = TAB1.<NBOB ;
  1120.  
  1121. si (exis tab1 <remontee) ;
  1122. TABPTS1 = TAB1.<REMONTEE.<POINT ;
  1123. tablig1 = table ;
  1124. finsi ;
  1125.  
  1126. PASB2 = TAB1.<PAS_AVEC_TEST ;
  1127. DMAX2 = TAB1.<DIST_AVEC_TEST ;
  1128. NBPAS2 = TAB1.<NBPAS2 ;
  1129.  
  1130. SI (EXIS TAB1 <PAS_SANS_TEST) ;
  1131. PASB1 = TAB1.<PAS_SANS_TEST ;
  1132. DMAX1 = TAB1.<DIST_SANS_TEST ;
  1133. NBPAS1 = TAB1.<NBPAS1 ;
  1134. FINSI ;
  1135.  
  1136.  
  1137. SI (EXIS TAB1 <TOLERANCE) ;
  1138. TOL1 = TAB1.<TOLERANCE ;
  1139. SINON ;
  1140. TOL1 = 1.e-9 ;
  1141. FINSI ;
  1142.  
  1143. *
  1144. * --- PASSAGE EN TRI3 POUR LA PROC @INTERC
  1145. *
  1146.  
  1147. LMOT = s_ombran ELEM 'TYPE' ;
  1148. ntyp = dime LMOT ;
  1149. si (ntyp ega 2) ;
  1150. stri3 = elem s_ombran tri3 ;
  1151. squa4 = elem s_ombran qua4 ;
  1152. squtri3 = chan squa4 tri3 ;
  1153. s_ombra2 = squtri3 et stri3 ;
  1154. sinon ;
  1155. s_ombra2 = chan s_ombran tri3 ;
  1156. finsi ;
  1157.  
  1158. *
  1159. * ---
  1160. *
  1161. SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  1162. ISHIFT = VRAI ;
  1163. IRIPPLE = VRAI ;
  1164. FINSI ;
  1165. SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  1166. ISHIFT = VRAI ;
  1167. IRIPPLE = FAUX ;
  1168. FINSI ;
  1169. SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  1170. ISHIFT = FAUX ;
  1171. IRIPPLE = VRAI ;
  1172. FINSI ;
  1173. SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  1174. ISHIFT = FAUX ;
  1175. IRIPPLE = FAUX ;
  1176. FINSI ;
  1177. SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  1178. ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
  1179. FINSI ;
  1180.  
  1181.  
  1182. * --- CONSTRUCTION DU MAILLAGE DES POINTS A REMONTER
  1183. si (exis tab1 <remontee) ;
  1184. MAILPTS = MANU POI1 TABPTS1 . 1 ;
  1185. NPTS = DIME TABPTS1 ;
  1186. REPETER BOUPTS1 (NPTS - 1) ;
  1187. MAILPTS = MAILPTS ET TABPTS1 . (&BOUPTS1 + 1) ;
  1188. FIN BOUPTS1 ;
  1189. sinon ;
  1190. * RM 15/06/2000 MAILPTS = MANU POI1 (s_ombre poin init) ;
  1191. MAILPTS = MANU POI1 ((chan s_ombre poi1) poin init) ;
  1192. TABPTS1 = table ;
  1193. TABPTS1 . 1 = (chan s_ombre poi1) poin init ;
  1194. npts = 1 ;
  1195. tablig1 = table ;
  1196. finsi ;
  1197.  
  1198.  
  1199. si (non (tab1.<reprise)) ;
  1200. * --- CREATION DES 3 CHMELEM DE COORDONNEES AUX ELEMENTS
  1201. * --- Remarque : ces coordonnees seront exprimees dans le repere globale
  1202. TAB1.<MAILLAGE = S_OMBRA2 ;
  1203. si (non (exis tab1 <chamx1)) ;
  1204. @RMCOORO TAB1 ;
  1205. finsi ;
  1206. * --- CALCUL DES NORMALES AUX ELEMENTS SUR LE MAILLAGE OMBRANT
  1207. si (non (exis tab1 <cosx)) ;
  1208. @RMNORM TAB1 ;
  1209. finsi ;
  1210. finsi ;
  1211.  
  1212.  
  1213. *
  1214. * --- Rappel des parametres de la procedure
  1215. *
  1216. MESS ' ';
  1217. MESS '##################################################';
  1218. MESS ' ';
  1219. MESS '>@ANALY> procedure OMBRAGE, Rappel des parametres de calcul ';
  1220. MESS ' ';
  1221.  
  1222. si (tab1.<reprise) ;
  1223. mess 'Reprise d un calcul';
  1224. mess '-------------------';
  1225. finsi ;
  1226.  
  1227. SI (IMETHOD EGA 1) ;
  1228. METH = 'methode explicite des tangentes';
  1229. FINSI ;
  1230. SI (IMETHOD EGA 2) ;
  1231. METH = 'methode moyenne des tangentes aux extremitee';
  1232. FINSI ;
  1233. SI (IMETHOD EGA 3) ;
  1234. METH = 'methode du point milieu';
  1235. FINSI ;
  1236. SI (IMETHOD EGA 4) ;
  1237. METH = 'methode de reprojection';
  1238. FINSI ;
  1239. MESS ' ';
  1240.  
  1241. SI (EXIS tab1 <PAS_SANS_TEST) ;
  1242. MESS 'Calcul en deux parties :';
  1243. MESS ' ';
  1244. MESS 'SANS TEST';
  1245. MESS 'Distance remontee :' DMAX1 ;
  1246. MESS 'Pas pour la remontee :' PASB1 ;
  1247. MESS 'Nombre d iterations :' NBPAS1 ;
  1248. MESS ' ';
  1249. MESS 'AVEC TEST';
  1250. MESS 'Distance remontee :' DMAX2 ;
  1251. MESS 'Pas pour la remontee :' PASB2 ;
  1252. MESS 'Nombre d iterations :' NBPAS2 ;
  1253. SINON ;
  1254. MESS 'Calcul avec test systematique :';
  1255. MESS 'Distance remontee :' DMAX2 ;
  1256. MESS 'Pas de remontee :' PASB2 ;
  1257. MESS 'Nombre d iterations :' NBPAS2 ;
  1258. FINSI ;
  1259. MESS ' ' ;
  1260.  
  1261. SI ISHIFT ;
  1262. MESS 'Calcul avec shift de Safranov' ;
  1263. SINON ;
  1264. MESS 'Calcul sans shift de Safranov';
  1265. FINSI ;
  1266.  
  1267. SI IRIPPLE ;
  1268. MESS 'Calcul avec ripple du champ toroidal' ;
  1269. SINON ;
  1270. MESS 'Calcul sans ripple du champ toroidal' ;
  1271. FINSI ;
  1272.  
  1273.  
  1274. *
  1275. *--------------------------------------------------------------
  1276. *
  1277. * INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  1278. * --- CAS SANS REPRISE ---
  1279. *--------------------------------------------------------------
  1280. si (non (tab1.<reprise)) ;
  1281. * --- initialisation du pas
  1282. I1 = 0 ;
  1283. * ---initialisation de la distance de connexion
  1284. CHDIST = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
  1285. * --- initialisation du maillage ou on va tester les intersections
  1286. s_ombre2 = s_ombre ;
  1287. * --- initialisation du maillage ou on va remonter les lignes
  1288. mailcou = s_ombre2 et mailpts ;
  1289. *---- initialisation des distances
  1290. LCOURAN1 = 0. ;
  1291. LMAX1 = 0. ;
  1292. * ---- coordonnees dans le repere du maillage
  1293. XM0 = COOR 1 mailcou ;
  1294. YM0 = COOR 2 mailcou ;
  1295. ZM0 = COOR 3 mailcou ;
  1296. *---- Coordonnees dans le repere global du tore
  1297. XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
  1298. *
  1299. * --- initialisation des lignes de champ remontees
  1300. REPETER BOUPTS1 NPTS ;
  1301. tablig1 . &BOUPTS1 = TABPTS1 . &BOUPTS1 ;
  1302. FIN BOUPTS1 ;
  1303.  
  1304. sinon ;
  1305. *
  1306. *--------------------------------------------------------------
  1307. *
  1308. * INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  1309. * --- CAS AVEC REPRISE ---
  1310. *--------------------------------------------------------------
  1311. * --- initialisation du pas
  1312. I1 = tab1.<i_ombrage ;
  1313. * --- initialisation de la distance de connexion
  1314. CHDIST = tab1.<chdist;
  1315. * --- initialisation du maillage ou on va tester les intersections
  1316. s_ombre2 = tab1.<s_omb_non_inter ;
  1317. * --- initialisation du maillage ou on va remonter les lignes
  1318. mailcou = s_ombre2 et mailpts ;
  1319.  
  1320.  
  1321. *---- initialisation des distances
  1322. LCOURAN1 = maxi chdist ;
  1323. LMAX1 = tab1.<CONNEXION_MAX ;
  1324.  
  1325. *---- Coordonnees dans le repere global du tore
  1326. XG_OLD = exco X tab1.<CHCOOR0 ;
  1327. YG_OLD = exco Y tab1.<CHCOOR0 ;
  1328. ZG_OLD = exco Z tab1.<CHCOOR0 ;
  1329. *
  1330.  
  1331. * --- initialisation des lignes de champ remontees
  1332. si (exis tab1 <remontee) ;
  1333. tablig1 = tab1.<remontee.<ligne ;
  1334. sinon ;
  1335. tablig1 . 1 = (TABPTS1 . 1) d 1 (TABPTS1.1 plus (0. 0. 0.));
  1336. finsi ;
  1337.  
  1338. finsi ;
  1339.  
  1340. *--------------------------------------------------------------
  1341. *
  1342. * DEBUT DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
  1343. *
  1344. *--------------------------------------------------------------
  1345. *
  1346. MESS ' ';
  1347. MESS '##################################################';
  1348. MESS ' ';
  1349.  
  1350. SI (EXIS TAB1 <DIST_SANS_TEST) ;
  1351.  
  1352. * ------------------ Boucle 1 on remonte sans test -------------------
  1353. PASB0 = PASB1 ;
  1354. * increment de la distance de connexion (= PAS tant qu'il n'y a pas
  1355. * d'intersection)
  1356. chdist9 = manu chpo s_ombre2 1 scal pasb0 ;
  1357.  
  1358. MESS 'PREMIERE PARTIE DU CALCUL, SANS TEST D INTERSECTION';
  1359. REPETER BOUCLE1 NBPAS1 ;
  1360. I1 = I1 + 1 ;
  1361. LCOURAN1 = LCOURAN1 + PASB0 ;
  1362. MESS ' ';
  1363. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  1364.  
  1365. * ---- Appel de la procedure de remontee des lignes de champ
  1366. XG_NEW YG_NEW ZG_NEW = @remonte XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1 ;
  1367.  
  1368. *--- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  1369. chdist = chdist + CHDIST9 ;
  1370.  
  1371.  
  1372. *-----------------------------------------------------------------
  1373. *--- construction des lignes de champ remontees
  1374. * --- Extraction des coordonnees des points a remonter
  1375. xmailpt1 = redu XG_NEW mailpts ;
  1376. ymailpt1 = redu YG_NEW mailpts ;
  1377. zmailpt1 = redu ZG_NEW mailpts ;
  1378.  
  1379. * --- Calcul des coordonnees des points a remonter dans le repere du maillage
  1380. xmailpt2 ymailpt2 zmailpt2 = @crgmc xmailpt1 ymailpt1 zmailpt1 tab1 ;
  1381. *
  1382. * --- Construction des lignes de remontee
  1383. repeter boupts2 npts ;
  1384. xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts2) ;
  1385. yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts2) ;
  1386. zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts2) ;
  1387. prem2 = xprem2 yprem2 zprem2 ;
  1388. tablig1.&boupts2 = (tablig1 . &boupts2) d 1 prem2 ;
  1389. fin boupts2 ;
  1390. **-----------------------------------------------------------------
  1391.  
  1392.  
  1393. * --- actualisation des champs de coordonnees pour iteration suivante
  1394.  
  1395. XG_OLD = XG_NEW ;
  1396. YG_OLD = YG_NEW ;
  1397. ZG_OLD = ZG_NEW ;
  1398.  
  1399. MENA ;
  1400.  
  1401. FIN BOUCLE1 ;
  1402. * ------------------------ Fin de la boucle 1 ------------------------
  1403. finsi ;
  1404.  
  1405.  
  1406. MESS ' ';
  1407. MESS '##################################################';
  1408. MESS ' ';
  1409.  
  1410. MESS 'CALCUL AVEC TEST D INTERSECTION';
  1411.  
  1412. * ------------------ Boucle 2 on remonte avec test -------------------
  1413. PASB0 = PASB2 ;
  1414. si (non (tab1.<reprise)) ;
  1415. s_ombre2 = chan s_ombre poi1 ;
  1416. mailcou = s_ombre2 et mailpts ;
  1417. finsi ;
  1418. REPETER BOUCLE2 NBPAS2 ;
  1419.  
  1420. I1 = I1 + 1 ;
  1421. LCOURAN1 = LCOURAN1 + PASB0 ;
  1422. MESS ' ';
  1423. MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;
  1424.  
  1425. * ---- Appel de la procedure de remonter des lignes de champ
  1426. XG_NEW YG_NEW ZG_NEW = @remonte XG_OLD YG_OLD ZG_OLD PASB0 CHSIGN1 TAB1 ;
  1427. *---- ------test sur les eventuels noeuds interceptes -----------
  1428. *---- seulement s'il reste des noeuds non encore intersectes ----
  1429. si (nbno s_ombre2 > 0.) ;
  1430.  
  1431. * --- Les CHPO sont reduits sur les points de s_ombre
  1432. * --- qui n'ont pas encore ete intersectes : s_ombre2
  1433.  
  1434. XG_OLD_R = REDU XG_OLD S_OMBRE2 ;
  1435. YG_OLD_R = REDU YG_OLD S_OMBRE2 ;
  1436. ZG_OLD_R = REDU ZG_OLD S_OMBRE2 ;
  1437.  
  1438. XG_NEW_R = REDU XG_NEW S_OMBRE2 ;
  1439. YG_NEW_R = REDU YG_NEW S_OMBRE2 ;
  1440. ZG_NEW_R = REDU ZG_NEW S_OMBRE2 ;
  1441.  
  1442.  
  1443. XG_OLD_R = NOMC X XG_OLD_R 'NATU' 'DIFFUS' ;
  1444. YG_OLD_R = NOMC Y YG_OLD_R 'NATU' 'DIFFUS' ;
  1445. ZG_OLD_R = NOMC Z ZG_OLD_R 'NATU' 'DIFFUS' ;
  1446.  
  1447. CH_OLD = XG_OLD_R ET YG_OLD_R ET ZG_OLD_R ;
  1448.  
  1449.  
  1450. XG_NEW_R = NOMC X XG_NEW_R 'NATU' 'DIFFUS' ;
  1451. YG_NEW_R = NOMC Y YG_NEW_R 'NATU' 'DIFFUS' ;
  1452. ZG_NEW_R = NOMC Z ZG_NEW_R 'NATU' 'DIFFUS' ;
  1453.  
  1454. CH_NEW = XG_NEW_R ET YG_NEW_R ET ZG_NEW_R ;
  1455.  
  1456. *
  1457. * --- APPEL DE LA PROCEDURE DE CALCUL DES NOEUDS INTERSECTES
  1458. *
  1459. * CHDIST9 MINTER = @INTERC CH_OLD CH_NEW TOL1 TAB1 ;
  1460. CHDIST9 MINTER = ITRC CH_OLD CH_NEW TOL1 TAB1 ;
  1461.  
  1462. * CHDIST9 = CHPO CONTENANT PAS POUR LES NOEUDS INTERSECTES
  1463. * ET D(M,PT_REMONTE) SINON
  1464.  
  1465.  
  1466. * S_OMBRE2 contient les noeuds de s_ombre qui n'ont
  1467. * pas ete intesectes.
  1468. s_ombre2 = diff s_ombre2 MINTER ;
  1469.  
  1470. * actualisation du maillage de remontee
  1471. mailcou = s_ombre2 et mailpts ;
  1472.  
  1473. CHSIGN1 = REDU CHSIGN1 mailcou ;
  1474.  
  1475. SI ((NBNO MINTER) > 0) ;
  1476. mess 'nombre de noeuds intersectes ' (NBNO MINTER) ;
  1477. LMAX1 = LCOURAN1 - pasb0 + (mini CHDIST9) ;
  1478. FINSI ;
  1479.  
  1480. * --- CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  1481. chdist = chdist + CHDIST9 ;
  1482. mess 'mini maxi dist connection en m' (mini (prog lmax1 (mini chdist))) lmax1 ;
  1483.  
  1484.  
  1485. finsi ;
  1486. * ------------------ fin du test d'interception ------------------
  1487.  
  1488.  
  1489.  
  1490. *-----------------------------------------------------------------
  1491. *--- construction des lignes de champ remontees
  1492. *--- Extraction des coordonnees des points a remonter
  1493. xmailpt1 = redu XG_NEW mailpts ;
  1494. ymailpt1 = redu YG_NEW mailpts ;
  1495. zmailpt1 = redu ZG_NEW mailpts ;
  1496.  
  1497. *--- Calcul des coordonnees des points a remonter dans le repere du maillage
  1498. xmailpt2 ymailpt2 zmailpt2 = @crgmc xmailpt1 ymailpt1 zmailpt1 tab1 ;
  1499.  
  1500. *--- Construction des lignes de remontee
  1501. repeter boupts3 npts ;
  1502. xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts3) ;
  1503. yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts3) ;
  1504. zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts3) ;
  1505. prem2 = xprem2 yprem2 zprem2 ;
  1506. tablig1 . &boupts3 = (tablig1 . &boupts3) d 1 prem2 ;
  1507. fin boupts3 ;
  1508. *-----------------------------------------------------------------
  1509.  
  1510.  
  1511.  
  1512. * --- actualisation des champs de coordonnees pour iteration suivante
  1513.  
  1514. XG_OLD = redu XG_NEW mailcou;
  1515. YG_OLD = redu YG_NEW mailcou;
  1516. ZG_OLD = redu ZG_NEW mailcou;
  1517.  
  1518. MENA ;
  1519.  
  1520. FIN BOUCLE2 ;
  1521. * --------------------- Fin de la boucle 2 ----------------------
  1522.  
  1523.  
  1524. *--- Sorties dans TAB1
  1525.  
  1526. TAB1.<CHDIST = CHDIST ;
  1527. TAB1.<CONNEXION_MAX = LMAX1 ;
  1528. TAB1.<LONGUEUR_REMONTEE = LCOURAN1 ;
  1529.  
  1530. si (exis tab1 <remontee) ;
  1531. tab1 . <remontee . <ligne = tablig1 ;
  1532. finsi ;
  1533.  
  1534. *Sauvegardes pour reprise eventuelle
  1535. XG_OLD = nomc X XG_OLD nature discret ;
  1536. YG_OLD = nomc Y YG_OLD nature discret ;
  1537. ZG_OLD = nomc Z ZG_OLD nature discret ;
  1538. tab1.<CHCOOR0 = (XG_OLD et YG_OLD et ZG_OLD) ;
  1539. tab1.<s_omb_non_inter = s_ombre2 ;
  1540. tab1.<i_ombrage = i1 ;
  1541.  
  1542. MESS '---------------------------------> exiting @ANALY';
  1543. FINPROC ;
  1544.  
  1545. **** @ARANGU
  1546. DEBPROC @ARANGU T1*FLOTTANT V1*FLOTTANT E1*FLOTTANT ;
  1547. *-------------------------------------------------------------------*
  1548. * R. Mitteau
  1549. * Fatigue du cuivre OFHC
  1550. *
  1551. * D'apres la publi
  1552. *
  1553. *
  1554. * High Temperature Torsional Low Cycle Fatigue of OFHC Copper
  1555. * Ahmet Aran and Dogan Erdun Gucer, Material Research Division,
  1556. * Marmara Research Institute...
  1557. *
  1558. * in Z. Metallkunde
  1559. * T1 temperature en degres K
  1560. * V1 vitesse de deformation en s-1
  1561. * E1 Deformation en .
  1562. *
  1563. *
  1564. *23456789012345678901234567890123456789012345678901234567890123456789012
  1565. * 1 2 3 4 5 6 7
  1566. *-------------------------------------------------------------------*
  1567. MESS '-----------------------------------------------> calling @ARANGU';
  1568. *
  1569. * --- donnees
  1570. *
  1571. * Temperature de la matiere en Kelvin
  1572. TLIEU1 = T1 ;
  1573. * Variation equivalente de la deformation au lieu considere
  1574. EPSETOI1 = E1 ;
  1575. * Vitesse de deformation
  1576. VDEF1 = V1 ;
  1577.  
  1578. *
  1579. * --- Calcul du alpha de la loi de Mansson-Coffin
  1580. *
  1581. EVALPH1 = EVOL MANU 'T' (PROG 293 438 588 668 ) 'ALPH' (PROG .67 .71 .63 .50 );
  1582. EVALPH2 = EVOL MANU 'T' (PROG 293 438 588 668 ) 'ALPH' (PROG .64 .79 .69 .50 );
  1583.  
  1584. VALALPH1 = IPOE EVALPH1 TLIEU1 FIXE;
  1585. VALALPH2 = IPOE EVALPH2 TLIEU1 FIXE;
  1586.  
  1587. EVALPH3 = EVOL MANU 'VDEF' (PROG 1.81E-3 9.05E-3 ) 'ALPH' (PROG VALALPH1 VALALPH2);
  1588.  
  1589. ALPHA1 = IPOE VDEF1 EVALPH3 LINE;
  1590.  
  1591.  
  1592.  
  1593. *
  1594. * --- Calcul du C de la loi de Mansson-Coffin
  1595. *
  1596. EVC1 = EVOL MANU 'T' (PROG 293 438 588 668 ) 'C' (PROG 5.77 6.3 3.56 0.72 );
  1597. EVC2 = EVOL MANU 'T' (PROG 293 438 588 668 ) 'C' (PROG 5.03 12.25 7.01 1.09 );
  1598.  
  1599. VALC1 = IPOE EVC1 TLIEU1 FIXE;
  1600. VALC2 = IPOE EVC2 TLIEU1 FIXE;
  1601.  
  1602. EVC3 = EVOL MANU 'VDEF' (PROG 1.81E-3 9.05E-3 ) 'C' (PROG VALC1 VALC2);
  1603.  
  1604. CA1 = IPOE VDEF1 EVC3 LINE;
  1605.  
  1606.  
  1607. *
  1608. * --- Calcul du nombre de cycles
  1609. *
  1610.  
  1611. NCYCLES1 = (CA1/EPSETOI1) ** (1. / ALPHA1) ;
  1612. NCYCLES2 = ENTI (NCYCLES1 + 1);
  1613. MESS '>@ARANGU> Temperature [K] : ' T1 ;
  1614. MESS '>@ARANGU> Deformation speed [S-1] : ' V1 ;
  1615. MESS '>@ARANGU> Rupture according to Aran-Gucer [cycles]: ' NCYCLES2 ;
  1616.  
  1617. MESS '-----------------------------------------------> exiting @ARANGU';
  1618. FINPROC NCYCLES1;
  1619.  
  1620. **** @BOWRI72
  1621. DEBPROC @BOWRI72 TAB_1*TABLE ;
  1622. *
  1623. *
  1624. * CALCUL DU FLUX CRITIQUE SUIVANT LA CORRELATION DE BOWRING
  1625. *23456789012345678901234567890123456789012345678901234567890123456789012
  1626. * 1 2 3 4 5 6 7
  1627. *
  1628. * --- entrees
  1629. *
  1630. INIVEAU1 = TAB_1.'NIVEAU' ;
  1631. D_DIAM1 = TAB_1.'D_DIAM' ;
  1632. L_LONG1 = TAB_1.'L_HEATED' ;
  1633. P_PRES1 = TAB_1.'P_IN' ;
  1634. V_VITE1 = TAB_1.'V_IN' ;
  1635. T_TEMP1 = TAB_1.'T_IN' ;
  1636. TEST1 = FAUX ;
  1637. SI (EXISTE TAB1 ANNULE_D_DEF);
  1638. SI TAB1.ANNULE_D_DEF ;
  1639. TEST1 = VRAI;
  1640. FINSI ;
  1641. FINSI ;
  1642.  
  1643. *
  1644. * --- racine
  1645. *
  1646. SI (INIVEAU1 >EG 2 ) ;
  1647. MESS '---------------------------------> calling @BOWRI72';
  1648. FINSI ;
  1649. PI = 3.14159;
  1650. LOGI_1 = EXISTE TAB_1 EPTSAT;
  1651. LOGI_2 = EXISTE TAB_1 ETHFG;
  1652. LOGI_3 = EXISTE TAB_1 ETRHOF;
  1653. LOGI_4 = EXISTE TAB_1 ETCPF;
  1654. SI (NON (LOGI_1 ET LOGI_2 ET LOGI_3 ET LOGI_4));
  1655. @TABEAU TAB_1 ;
  1656. FINSI ;
  1657.  
  1658. *
  1659. * --- Test du domaine de definition des entrees
  1660. *
  1661. G_VITE1 = V_VITE1 * (@IPOE TAB_1.ETRHOF T_TEMP1);
  1662.  
  1663. SI TEST1 ;
  1664. * - test sur la vitesse de l'eau
  1665. SI ((G_VITE1 < 136.) OU ( G_VITE1 > 18600.)) ;
  1666. MESS 'Vitesse massique : ' G_VITE1;
  1667. ERRE '@BOWRING -> Vitesse massique hors [136. , 18600.] (Kg/M2/S)';
  1668. FINSI ;
  1669.  
  1670. * - test sur le diametre
  1671. SI ((D_DIAM1 < 2.E-3) OU (D_DIAM1 > 450.E-3)) ;
  1672. MESS 'Diametre : ' D_DIAM1;
  1673. ERRE '@BOWRING -> Diametre hors [0.002 0.45] (M)' ;
  1674. FINSI ;
  1675.  
  1676. * - test sur la Pression
  1677. SI ((P_PRES1 < 1.E5) OU (P_PRES1 > 200.E5)) ;
  1678. MESS 'Pression : ' P_PRES1;
  1679. ERRE '@BOWRING -> Pression hors de [1.E5, 200.E5] (Pa) ' ;
  1680. FINSI ;
  1681.  
  1682. * - test sur la longueur chauffee
  1683. SI ((L_LONG1 < 0.15) OU (L_LONG1 > 3.7)) ;
  1684. MESS 'Longueur : ' L_LONG1;
  1685. ERRE '@BOWRING --> Longueur hors de [0.15,3.7](M) ' ;
  1686. FINSI ;
  1687.  
  1688. * Fin des tests sur les entrees de @BOWRI72
  1689. FINSI ;
  1690.  
  1691. T_SAT = @IPOE TAB_1.EPTSAT P_PRES1 ;
  1692.  
  1693. P1 = P_PRES1 / 6900000. ;
  1694. SI (INIVEAU1 >EG 2) ;
  1695. MESS 'P_PRIME : ' P1 ;
  1696. FINSI ;
  1697.  
  1698. SI (P1 &lt;EG 1.) ;
  1699. F1 = (((P1 ** 18.942) * (EXP (20.8 * (1. - P1)))) + 0.917) / 1.917;
  1700. F2 = (F1 * 1.309)/(((P1 ** 1.316)*(EXP(2.444*(1. - P1)))) + 0.309);
  1701. F3 = (((P1 ** 17.023)*(EXP(16.658*(1. - P1)))) + 0.667)/1.667;
  1702. F4 = F3 * (P1 ** 1.649) ;
  1703. SINON ;
  1704. F1 = (P1 ** (-0.368))*(EXP(0.648*(1. - P1)));
  1705. F2 = (P1 ** (-0.448))*(EXP(0.245*(1. - P1)));
  1706. F3 = P1 ** 0.219;
  1707. F4 = F3 * (P1 ** 1.649) ;
  1708. FINSI ;
  1709.  
  1710. SI (INIVEAU1 >EG 2) ;
  1711. MESS 'F1 : ' F1 ;
  1712. MESS 'F2 : ' F2 ;
  1713. MESS 'F3 : ' F3 ;
  1714. MESS 'F4 : ' F4 ;
  1715. FINSI ;
  1716.  
  1717.  
  1718. L_VAP = @IPOE TAB_1.ETHFG T_TEMP1 ;
  1719. CP__1 = @IPOE TAB_1.ETCPF T_TEMP1 ;
  1720.  
  1721. S_SAT = CP__1 * (T_SAT - T_TEMP1) ;
  1722.  
  1723. SI (INIVEAU1 >EG 2) ;
  1724. MESS 'L_VAP : ' L_VAP ;
  1725. MESS 'CP__1 : ' CP__1 ;
  1726. MESS 'S_SAT : ' S_SAT ;
  1727. FINSI ;
  1728.  
  1729. A__1 = 0.5793 * L_VAP * D_DIAM1 * G_VITE1 * F1 / (1. + (0.0143 * F2 * (D_DIAM1 ** .5) * G_VITE1 )) ;
  1730.  
  1731. B__1 = .25 * D_DIAM1 * G_VITE1 ;
  1732.  
  1733. C__1 = 0.077 * D_DIAM1 * G_VITE1 * F3 / (1. + (0.347 * F4 * ((G_VITE1/1356.) ** (2. - (.5 * P1))))) ;
  1734.  
  1735. SI (INIVEAU1 >EG 5) ;
  1736. MESS 'A : ' A__1 ;
  1737. MESS 'B : ' B__1 ;
  1738. MESS 'C : ' C__1 ;
  1739. FINSI ;
  1740.  
  1741. QCHFW = (A__1 + (B__1 * S_SAT)) / (C__1 + L_LONG1) ;
  1742.  
  1743. G1 = G_VITE1 * PI * D_DIAM1 * D_DIAM1 / 4. ;
  1744. *
  1745. * --- sortie de la procedure
  1746. *
  1747.  
  1748. SI ( INIVEAU1 >EG 1 ) ;
  1749. MESS '>>@BOWRI72>> TUBE DIAMETER (M) : ' D_DIAM1 ;
  1750. MESS '>>@BOWRI72>> TUBE LENGHT (M) : ' L_LONG1 ;
  1751. MESS '>>@BOWRI72>> MASS FLOW VELOCITY (KG/S/M2) : ' G_VITE1;
  1752. MESS '>>@BOWRI72>> INLET MASS FLOW RATE (KG/S) : ' G1 ;
  1753. MESS '>>@BOWRI72>> VELOCITY (M/S) : ' V_VITE1 ;
  1754. MESS '>>@BOWRI72>> FLUID INLET TEMPERATURE (C) : ' T_TEMP1 ;
  1755. MESS '>>@BOWRI72>> FLUID INLET PRESSURE (PA) : ' P_PRES1 ;
  1756. MESS '>>@BOWRI72>> WATER SATURATION TEMPERATURE(C) : ' T_SAT ;
  1757. MESS '>>@BOWRI72>> WALL CRITICAL HEAT FLUX (W/m2) : ' QCHFW ;
  1758. FINSI ;
  1759.  
  1760. SI (INIVEAU1 >EG 2 ) ;
  1761. MESS '---------------------------------> Sortie de @BOWRI72';
  1762. FINSI ;
  1763. *
  1764. * --- sorties
  1765. *
  1766. TAB1.CHF = QCHFW ;
  1767.  
  1768. FINPROC ;
  1769.  
  1770.  
  1771. debproc @calcflu mod1*mmodel cht1*chpoint mat1*chpoint ;
  1772.  
  1773. gradt1 = grad cht1 mod1 ;
  1774. flux1 = mat1 * gradt1 ;
  1775.  
  1776. finproc flux1 ;
  1777.  
  1778. **** @CALHCON
  1779. DEBPROC @CALHCON TAB_1*TABLE ;
  1780.  
  1781. *
  1782. * !!! R. MITTEAU !!! attention, procedure standard
  1783. *
  1784. * un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
  1785. * pour les mises a jour
  1786. *
  1787. *-------------------------------------------------------------------*
  1788. * *
  1789. * COEFFICIENT D ECHANGE TENANT COMPTE *
  1790. * DE L EBULLITION SOUS SATUREE *
  1791. * *
  1792. *-------------------------------------------------------------------*
  1793. *
  1794. DIAM = TAB_1 . D_MAQUETTE ;
  1795. TTAPE = TAB_1 . T_TAPE ;
  1796. YTW1 = TAB_1 . TWIST_RATIO ;
  1797. V1 = TAB_1 . V_LOCAL ;
  1798. *js 20/4/95 je change T_MOY en t_local ????
  1799. T_LOC1 = TAB_1 . 'T_LOCAL' ;
  1800. NIVEAU = TAB_1.'NIVEAU' ;
  1801. P_LOCAL1 = TAB_1.'P_LOCAL' ;
  1802. L1TRAC = TAB_1.'TRAC_GRAPHE' ;
  1803. *
  1804. SI (NIVEAU >EG 4) ;
  1805. MESS '-----------------------------------> calling @CALHCON ' ;
  1806. FINSI ;
  1807. *
  1808. *
  1809. PI = 3.14159 ;
  1810. *S1 = PI * DIAM * DIAM / 4. ;
  1811. SI ( NON ( EXISTE TAB_1 HYPERVAP ) ) ;
  1812. TAB_1.HYPERVAP = FAUX ;
  1813. FINSI ;
  1814. SI ( ( YTW1 EGA 0. 1.E-6 ) ET ( EGA TAB_1.HYPERVAP FAUX ) ) ;
  1815. S1 = PI * DIAM * DIAM / 4. ;
  1816. TAB_1.DH = DIAM ;
  1817. FACV = 1. ;
  1818. FACF = 1. ;
  1819. FINSI ;
  1820. SI ( NON ( EXISTE TAB_1 HELI_WIRE ) ) ;
  1821. TAB_1.HELI_WIRE = FAUX ;
  1822. FINSI ;
  1823. SI ( ( YTW1 EGA 0. 1.E-6 ) ET ( EGA TAB_1.HELI_WIRE VRAI ) ET ( EGA TAB_1.HYPERVAP FAUX ) ) ;
  1824. S1 = PI * DIAM * DIAM / 4. ;
  1825. SM = PI * TAB_1.WIRE_D * TAB_1.WIRE_D / 4. ;
  1826. P1 = PI * DIAM ;
  1827. PM = PI * TAB_1.WIRE_D ;
  1828. TAB_1.DH = 4. * ( S1 - SM ) / ( P1 + PM ) ;
  1829. PIS2Y = PI / ( 2 * TAB_1.PITCH_WIRE ) ;
  1830. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  1831. * FACV = 1. ;
  1832. FACF = 1. ;
  1833. FINSI ;
  1834. *
  1835. SI ( ( YTW1 EGA 0. 1.E-6 ) ET ( EGA TAB_1.HYPERVAP VRAI ) ) ;
  1836. SM = ( TAB_1 . LARG_CANAL * TAB_1 . HMIN_CANAL ) + ( 2. * ( TAB_1 . LARG_ESP * TAB_1 . HFIN ) ) ;
  1837. PM = TAB_1 . LARG_CANAL + ( 2.* TAB_1 . HMAX_CANAL ) + ( 2. * TAB_1 . LARG_ESP ) + ( 2. * TAB_1 . HFIN ) + TAB_1 . LFIN ;
  1838. TAB_1.DH = 4. * SM / PM ;
  1839. FACV = 1. ;
  1840. * FACF = 2.25 ;
  1841. * modif 261099 calcul du rapport Strue/Sapparent
  1842. * N CURT
  1843. SI (TAB_1.HFIN > 0. ) ;
  1844.  
  1845.  
  1846. S_E1 = ((4.*TAB_1.HFIN)+(2.*TAB_1.LARG_ESP)+(TAB_1.LFIN))* (TAB_1.FF + TAB_1.f0) ;
  1847. S_E2 = ((4.*TAB_1.HFIN)+(2.*TAB_1.LARG_ESP)+(TAB_1.LFIN))* (TAB_1.FF) ;
  1848. S_E3 = 2.* (TAB_1.LFIN * (TAB_1.HFIN - TAB_1.RFIN)) ;
  1849. S_E4 = PI * ( TAB_1.RFIN * TAB_1.LFIN) ;
  1850. S_E5 = 2. * (( TAB_1.HFIN + TAB_1.LARG_ESP) * TAB_1.f0) ;
  1851. S_E6 = TAB_1.RFIN * ((2.*TAB_1.f0)-(PI* TAB_1.RFIN)) ;
  1852. FACF = (S_E2+S_E3+S_E4+S_E5+S_E6)/ S_E1 ;
  1853. SINON ;
  1854. FACF = 1. ;
  1855. FINSI ;
  1856. *fin modif
  1857.  
  1858. TAB_1.FACCF = FACF ;
  1859. TAB_1.HYP_SM = SM ;
  1860. FINSI ;
  1861. SI ( YTW1 > 0. ) ;
  1862. QUAS = 4. * ( ( PI * DIAM * DIAM / 8.) - ( TTAPE * DIAM / 2. ) ) ;
  1863. PERI = ( ( PI * DIAM / 2.) - TTAPE + DIAM ) ;
  1864. TAB_1.DH = QUAS / PERI ;
  1865. PIS2Y = PI / ( 2. * YTW1 ) ;
  1866. FACV = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  1867. FACF = 1.15 ;
  1868. FINSI ;
  1869. SI ( EXISTE TAB_1 RIP_FLOWS ) ;
  1870. S1 = ( TAB_1 . RIP_FLOWS ) ;
  1871. FINSI ;
  1872. SI ( EXISTE TAB_1 RIP_WETP ) ;
  1873. PERI = ( TAB_1 . RIP_WETP ) ;
  1874. TAB_1.DH = 4. * S1 / PERI ;
  1875. FINSI ;
  1876. SI ( EXISTE TAB_1 RIP_TWIST ) ;
  1877. PIS2Y = PI / ( 2. *( TAB_1 . RIP_TWIST ) ) ;
  1878. FACV2 = ( 1. + ( PIS2Y ** 2 ) ) ** 0.5 ;
  1879. FACV = MAXI ( PROG FACV FACV2 ) ;
  1880. FINSI ;
  1881.  
  1882. SI ( EGA TAB_1.HYPERVAP FAUX ) ;
  1883. FACD = ( DIAM / TAB_1.DH ) ** 0.2 ;
  1884. FACT = ( FACV ** 0.8 ) * FACD * FACF ;
  1885. SINON ;
  1886. FACD = 1. ;
  1887. FACT = ( FACV ** 0.8 ) * FACD * FACF ;
  1888. FINSI ;
  1889. * modif pour calcul W7x provisoire
  1890. * adaptation du coef correctif W7X du au swirl
  1891. * N CURT 18012000
  1892. * SI ( EGA TAB_1.HYPERVAP FAUX ) ;
  1893. * SI (YTW1 > 0. ) ;
  1894. * FACF = 2.18 * ((YTW1)**(-1 * 0.09)) ;
  1895. * FACF = 2.26 * ((YTW1)**(-1 * 0.248)) ;
  1896. * FACD = 1. ;
  1897. * FACV = 1. ;
  1898. * FACT = ( FACV ** 0.8 ) * FACD * FACF ;
  1899. * SINON ;
  1900. *FACD = ( DIAM / TAB_1.DH ) ** 0.2 ;
  1901. * FACT = ( FACV ** 0.8 ) * FACD * FACF ;
  1902. * FINSI ;
  1903. * SINON ;
  1904. * FACD = 1. ;
  1905. * FINSI ;
  1906. * fin modif
  1907. *
  1908. * attention modification par R. MITTEAU le 7 fevrier 1994
  1909. * j'ai rajoute les " FIXE " pour pouvoir passer un calcul
  1910. * dans lequel l'eau est quasi immobile. Car dans ce cas les valeurs
  1911. * sont en dehors des tables
  1912.  
  1913. * avant modif
  1914. *TSAT = @IPOE P_LOCAL1 TAB_1.EPTSAT ;
  1915. *NNU = @IPOE T_LOC1 TAB_1.ETNNU ;
  1916. *RHO = @IPOE T_LOC1 TAB_1.ETRHOF ;
  1917. *PR = @IPOE T_LOC1 TAB_1.ETPRAF ;
  1918. *LLAM = @IPOE T_LOC1 TAB_1.ETLLA ;
  1919. *NNUB = @IPOE T_LOC1 TAB_1.ETNNU ;
  1920.  
  1921. * apres modif raph
  1922. *MESS '>>PRESS T_MOY S1' P_LOCAL T_LOC1 ;
  1923. TSAT = @IPOE P_LOCAL1 TAB_1.EPTSAT FIXE ;
  1924. NNU = @IPOE T_LOC1 TAB_1.ETNNU FIXE ;
  1925. RHO = @IPOE T_LOC1 TAB_1.ETRHOF FIXE ;
  1926. PR = @IPOE T_LOC1 TAB_1.ETPRAF FIXE ;
  1927. LLAM = @IPOE T_LOC1 TAB_1.ETLLA FIXE ;
  1928. NNUB = @IPOE T_LOC1 TAB_1.ETNNU FIXE ;
  1929.  
  1930. *
  1931. RE = RHO * ( NNU ** -1 ) * V1 * TAB_1.DH * FACV ;
  1932. *
  1933. SI ( T_LOC1 < TSAT ) ;
  1934. LTWALL1 = PROG -52. pas 25. (T_LOC1 + 0.01) pas 25. TSAT pas 25. 350. 400. 450. 500. 1500. 2550. 3000. 3500. 20000. ;
  1935. SINON ;
  1936. LTWALL1 = PROG -52. pas 25. TSAT pas 25. 350. 400. 450. 500. 1500. 2550. 3000. 3500. 20000. ;
  1937. FINSI ;
  1938. *
  1939. LNNUW = @IPOE LTWALL1 TAB_1.ETNNU 'FIXE' ;
  1940. *modif NCURT 10012000
  1941. *calcul nb de Prandtl sur le mur
  1942. LPRW = @IPOE LTWALL1 TAB_1.ETPRAF 'FIXE' ;
  1943. *fin modif
  1944. LTETA = PROG ( DIME LTWALL1 ) * T_LOC1 ;
  1945. *
  1946. LM_ITETA = LTWALL1 MASQUE 'INFERIEUR' T_LOC1 ;
  1947. LM_STETA = LTWALL1 MASQUE 'EGSUP' T_LOC1 ;
  1948. *
  1949. *SI ( EGA TAB_1.L_CONVECT 'DITTUS_BOELTER' ) ;
  1950. NUS_2 = FACF * 0.023 * ( RE ** 0.8 ) * ( PR ** 0.4 ) ;
  1951. NUS_1 = FACF * 0.023 * ( RE ** 0.8 ) * ( PR ** 0.3 ) ;
  1952. LNUS_2 = PROG ( DIME LTWALL1 ) * NUS_2 ;
  1953. LNUS_1 = PROG ( DIME LTWALL1 ) * NUS_1 ;
  1954. LNUS = ( LNUS_1 * LM_ITETA ) + ( LNUS_2 * LM_STETA ) ;
  1955. LH_DB = LNUS * LLAM / TAB_1.DH ;
  1956. LFC_DB = ( LTWALL1 - LTETA ) * LH_DB;
  1957. TITRE 'DITTUS_BOELTER' ;
  1958. EVOFC_DB = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_DB ;
  1959. *FINSI ;
  1960. *
  1961. *SI ( EGA TAB_1.L_CONVECT 'SIEDER_TATE' ) ;
  1962. NUS1 = FACF * 0.027 * ( RE ** 0.8 ) * ( PR ** ( 1. / 3. )) ;
  1963. LNUS = ( ( LNNUW / NNUB ) ** -0.14 ) * NUS1 ;
  1964. LH_ST = LNUS * ( LLAM / TAB_1.DH ) ;
  1965. LFC_ST = ( LTWALL1 - LTETA ) * LH_ST ;
  1966. TITRE 'SIEDER_TATE' ;
  1967. EVOFC_ST = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_ST ;
  1968. *FINSI ;
  1969. *
  1970. *SI ( EGA TAB_1.L_CONVECT 'PETHUKOV' ) ;
  1971. F_P = (1. / ( 1.82 * ( ( LOG RE ) / ( LOG 10.) ) - 1.64 )) ** 2 ;
  1972. X_P = 1.07 + (12.7 * (PR ** (2. / 3.) - 1.) * ( (F_P / 8.) ** 0.5 ));
  1973. NUS1 = ( RE * PR * F_P ) / ( X_P * 8. ) ;
  1974. LNUS_2 = ( ( LNNUW / NNUB ) ** -0.11 ) * FACF * NUS1 ;
  1975. LNUS_1 = ( ( LNNUW / NNUB ) ** -0.25 ) * FACF * NUS1 ;
  1976. LNUS = (LNUS_1 * LM_ITETA) + (LNUS_2 * LM_STETA) ;
  1977. LH_P = LNUS * ( LLAM /TAB_1.DH ) ;
  1978. LFC_P = ( LTWALL1 - LTETA ) * LH_P ;
  1979. TITRE 'PETHUKOV' ;
  1980. EVOFC_P = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_P ;
  1981. *FINSI ;
  1982.  
  1983.  
  1984.  
  1985. *modif NCURT 10012000
  1986. *adaptation de la correlation non courte de Gnielinski
  1987. *cf Greuner 260499
  1988. *SI ( EGA TAB_1.L_CONVECT 'GNIELINSKI' ) ;
  1989. F_G = (1. / (1.82 * ( ( LOG RE ) / ( LOG 10.)) - 1.64 )) ** 2 ;
  1990. R_G = ( (PR ** (2. / 3.)) - 1.) * ( (F_G / 8.) ** 0.5) ;
  1991. X_G = 1. + (12.7 * R_G);
  1992. NUS3 = FACF * (((RE - 1000.)* PR) * F_G) / ( X_G * 8.) ;
  1993. * correlation courte
  1994. * NUS3 = FACF * 0.012 * ((RE ** 0.87) - 280. ) * (PR ** 0.4) ;
  1995. LNUS = ( ( LPRW / PR ) ** -0.11 ) * NUS3 ;
  1996. LH_GN = LNUS * ( LLAM/TAB_1.DH) ;
  1997. LFC_GN = ( LTWALL1 - LTETA ) * LH_GN ;
  1998. TITRE 'GNIELINSKI' ;
  1999. EVOFC_GN = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_GN ;
  2000.  
  2001. *fin modif
  2002.  
  2003.  
  2004. *SI ( EGA TAB_1.L_CONVECT 'JB_CONVEC' ) ;
  2005. SI (NON ( YTW1 EGA 0. 1.E-6 ) ) ;
  2006. FACFJB = 1. + ( 0.7 / YTW1 ) ;
  2007. SINON ;
  2008. FACFJB = 1. ;
  2009. FINSI ;
  2010. NUS_3 = FACFJB * 0.023 * ( RE ** 0.8 ) * ( PR ** 0.4 ) ;
  2011. LNUS = ( ( LNNUW / NNUB ) ** -0.25 ) * NUS_3 ;
  2012. LH_JB = LNUS * ( LLAM / TAB_1.DH ) ;
  2013. LFC_JB = ( LTWALL1 - LTETA ) * LH_JB ;
  2014. TITRE 'JB_CONVEC' ;
  2015. EVOFC_JB = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_JB ;
  2016. *FINSI ;
  2017. *
  2018. SI ( NON ( EXISTE TAB_1 L_CONVECT ) ) ;
  2019. *js TAB_1.L_CONVECT = 'DITTUS_BOELTER' ;
  2020. TAB_1.L_CONVECT = 'SIEDER_TATE' ;
  2021. FINSI ;
  2022. *
  2023. SI ( EGA TAB_1.L_CONVECT 'DITTUS_BOELTER' ) ;
  2024. LHCONV = LH_DB ;
  2025. FINSI ;
  2026. *
  2027. SI ( EGA TAB_1.L_CONVECT 'SIEDER_TATE' ) ;
  2028. LHCONV = LH_ST ;
  2029. FINSI ;
  2030. *
  2031. SI ( EGA TAB_1.L_CONVECT 'PETHUKOV' ) ;
  2032. LHCONV = LH_P ;
  2033. FINSI ;
  2034. *
  2035. SI ( EGA TAB_1.L_CONVECT 'JB_CONVEC') ;
  2036. LHCONV = LH_JB ;
  2037. FINSI ;
  2038.  
  2039. *modif 10012000
  2040. SI ( EGA TAB_1.L_CONVECT 'GNIELINSKI') ;
  2041. LHCONV = LH_GN ;
  2042. FINSI ;
  2043. *fin modif
  2044.  
  2045. *
  2046. * Calculation of TONB FONB Bergles & Rohsenow correlation
  2047. *
  2048. IONB = 0 ;
  2049. TB1 = TSAT + 15. ;
  2050. REPETER BOUCONB ;
  2051. IONB = IONB + 1 ;
  2052. SI ( IONB > 7 ) ;
  2053. QUITTER BOUCONB ;
  2054. FINSI ;
  2055. PRATIO = P_LOCAL1 * 1.E-5 ;
  2056. EXPO1 = 1. / ( 0.463 * ( PRATIO ** 0.0234 ) ) ;
  2057. DUM = ( 1. / 0.556 ) * ( TB1 - TSAT ) ;
  2058. FTBA = 1082. *( PRATIO ** 1.156 )* ( DUM ** EXPO1 ) ;
  2059. HCONV = IPOL TB1 LTWALL1 LHCONV ;
  2060. FTB = ( HCONV * ( TB1 - T_LOC1 ) ) - FTBA ;
  2061. ;
  2062. * **** CALCUL DE LA DERIVEE PAR RAPPORT A TB1-TETA **********
  2063. FTB1 = HCONV - ( ( EXPO1 * FTBA ) / ( TB1 - TSAT ) ) ;
  2064. * **** CALCUL DU NOUVEAU TB **********
  2065. TONB = TB1 - ( FTB / FTB1 ) ;
  2066. SI ( ( ABS ( TONB -TB1 ) ) &lt;EG 0.1 ) ;
  2067. QUITTER BOUCONB ;
  2068. FINSI ;
  2069. TB1 = TONB ;
  2070. FIN BOUCONB ;
  2071. MESS '>@CALHCON> TONB VALUE BY BERG.& ROHS. CORREL.: ' TONB ;
  2072. MESS '>@CALHCON> TONB PRECISION : ' ((TONB - TB1) / TONB);
  2073. *
  2074. *
  2075. SI ( T_LOC1 < TSAT ) ;
  2076. LTWALL2 = PROG -52. pas 25. (T_LOC1 + 0.01) pas 25. TSAT pas 5. (TONB + 0.01) pas 5. (TONB + 50.) pas 25. 450. 500. 1500. 3000. 2.1E4 ;
  2077. SINON ;
  2078. LTWALL2 = PROG -52. pas 25. TSAT pas 5. (TONB + 0.01) pas 5. (TONB + 50.) pas 25. 450. 500. 1500. 3000. 2.1E4 ;
  2079. FINSI ;
  2080.  
  2081. LTWALL = LTWALL2 ;
  2082. *
  2083. LHCONV = @ITPLT LTWALL1 LHCONV 'FIXE' LTWALL2 ;
  2084. LTETA = PROG ( DIME LTWALL ) * T_LOC1 ;
  2085. LTSAT = PROG ( DIME LTWALL ) * TSAT ;
  2086. LTONB = PROG ( DIME LTWALL ) * TONB ;
  2087. *
  2088. LM_ITSAT = LTWALL MASQUE 'INFERIEUR' TSAT ;
  2089. LM_STSAT = LTWALL MASQUE 'EGSUPE' TSAT ;
  2090. LM_ITONB = LTWALL MASQUE 'INFERIEUR' TONB ;
  2091. LM_STONB = LTWALL MASQUE 'EGSUPE' TONB ;
  2092. LM_ITON1 = LTWALL MASQUE 'EGINFE' TONB ;
  2093. LM_STON1 = LTWALL MASQUE 'SUPERIEUR' TONB ;
  2094. *
  2095. *SI ( EGA TAB_1.L_SUBNB 'THOM' ) ;
  2096. VEXPTM = EXP ( 1.E-5 * P_LOCAL1 / 87. ) ;
  2097. LFB_TM = ( LTWALL - LTSAT ) * ( VEXPTM / 22.65 ) ;
  2098. LFB_TM = ( LFB_TM ** 2 ) * 1.E6 ;
  2099. LFB_TM = LFB_TM * LM_STSAT ;
  2100. TITRE 'THOM' ;
  2101. EVOFB_TM = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TM ;
  2102. EVOFB_T1 = EVOFB_TM ;
  2103. *FINSI ;
  2104. *
  2105. SI ( NON ( EXISTE TAB_1 L_SUBNB ) ) ;
  2106. TAB_1.L_SUBNB = 'THOM_CEA' ;
  2107. SI ( NON ( EXISTE TAB_1 V_EXPTHOM ) ) ;
  2108. TAB_1 . V_EXPTHOM = 2.8 ;
  2109. FINSI ;
  2110. FINSI ;
  2111. *
  2112. SI ( EGA TAB_1.L_SUBNB 'THOM_CEA' ) ;
  2113. VEXPTM = EXP ( 1.E-5 * P_LOCAL1 / 87. ) ;
  2114. LFB_TM = ( LTWALL - LTSAT ) * ( VEXPTM / 22.65 ) ;
  2115. E_TMP = TAB_1.V_EXPTHOM / 2. ;
  2116. LFB_TMP = (( LFB_TM ** 2 ) ** E_TMP) * 1.E6 ;
  2117. LFB_TMP = LFB_TMP * LM_STSAT ;
  2118. TITRE 'THOM_CEA' ;
  2119. EVFB_TMP = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TMP ;
  2120. EVOFB_T1 = EVOFB_T1 ET EVFB_TMP ;
  2121. FINSI ;
  2122. *
  2123. SI ( EGA TAB_1.L_SUBNB 'T_JAERI' ) ;
  2124. VEXPTM = EXP ( 1.E-5 * P_LOCAL1 / 87. ) ;
  2125. LFB_TM = ( LTWALL - LTSAT ) * ( VEXPTM / 25.72 ) ;
  2126. E_TMJ = 3 / 2. ;
  2127. LFB_TMJ = (( LFB_TM ** 2 ) ** E_TMJ) * 1.E6 ;
  2128. LFB_TMJ = LFB_TMJ * LM_STSAT ;
  2129. TITRE 'T_JAERI' ;
  2130. EVFB_TMJ = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TMJ ;
  2131. EVOFB_T1 = EVOFB_T1 ET EVFB_TMJ ;
  2132. FINSI ;
  2133. *
  2134. *SI ( EGA TAB_1.L_SUBNB 'JENS_LOTTES' ) ;
  2135. VEXPJL = EXP ( 1.E-5 * P_LOCAL1 / 62. ) ;
  2136. LFB_JL = ( LTWALL - LTSAT ) * ( VEXPJL / 25. ) ;
  2137. LFB_JL = ( LFB_JL ** 4 ) * 1.E6 ;
  2138. LFB_JL = LFB_JL * LM_STSAT ;
  2139. TITRE 'JENS_LOTTES' ;
  2140. EVOFB_JL = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_JL ;
  2141. *FINSI ;
  2142. *
  2143. SI ( EGA TAB_1.L_SUBNB 'YIN' ) ;
  2144. D_YIN1 = 7.195 * ( TAB_1.GAM_YIN ** 1.82 ) ;
  2145. D_YIN2 = ( 1.E-5 * P_LOCAL1 ) ** 0.072 ;
  2146. LFB_YIN = ( 1.E6 * ( LTWALL - LTSAT ) ) / ( D_YIN1 * D_YIN2 ) ;
  2147. LFB_YIN = LFB_YIN * LM_STSAT ;
  2148. TITRE 'YIN' ;
  2149. EVFB_YIN = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_YIN ;
  2150. FINSI ;
  2151. *
  2152. TAC1 = TABLE ;
  2153. TAC1.1 = 'MARQ CROI REGU' ;
  2154. TAC1.2 = 'MARQ PLUS REGU' ;
  2155. TAC1.3 = 'MARQ ETOI REGU' ;
  2156. TAC1.4 = 'MARQ LOSA REGU' ;
  2157. TAC1.5 = 'MARQ CARR REGU' ;
  2158. TAC1.6 = 'MARQ TRIB REGU' ;
  2159. *
  2160. TAC2 = TABLE ;
  2161. TAC2.1 = 'MARQ CARR REGU' ;
  2162. TAC2.2 = 'MARQ LOSA REGU' ;
  2163. TAC2.3 = 'MARQ TRIA REGU' ;
  2164. TAC2.4 = 'MARQ TRIB REGU' ;
  2165. *
  2166. MESS '>@CALHCON> VELOCITY (M/S) : ' V1 ;
  2167.  
  2168. * MESS '>@CALHCON> MASS FLOW RATE ( KG/S ) : '
  2169. * (V1 * S1 * RHO) ;
  2170. MESS '>@CALHCON> FLUID TEMPERATURE (C) : ' T_LOC1 ;
  2171. MESS '>@CALHCON> FLUID PRESSURE ( PA ) : ' P_LOCAL1 ;
  2172. MESS '>@CALHCON> WATER SATURATION TEMPERATURE(C) : ' TSAT ;
  2173. *MESS '>@CALHCON> TUBE DIAMETER (M) : ' DIAM ;
  2174. MESS '>@CALHCON> TUBE HYDRAULIC DIAMETER (M) : ' TAB_1.DH ;
  2175. MESS '>@CALHCON> SWIRL TAPE THICKNESS (M) : ' TTAPE ;
  2176. MESS '>@CALHCON> TWIST RATIO : ' YTW1 ;
  2177. MESS '>@CALHCON> FLUID DENSITY ( KG/M**3) : ' RHO ;
  2178. MESS '>@CALHCON> FLUID CONDUCTIVITY ( W/M.K) : ' LLAM ;
  2179. MESS '>@CALHCON> REYNOLDS NUMBER : ' RE ;
  2180. MESS '>@CALHCON> FLUID VISCOSITY (KG/M.S) : ' NNU ;
  2181. MESS '>@CALHCON> PRANDTL NUMBER : ' PR ;
  2182. MESS '>@CALHCON> FACTOR DUE TO FIN EFFECT : ' FACF ;
  2183. MESS '>@CALHCON> FACTOR DUE TO CHANGE ON HYD.DIAM: ' FACD ;
  2184. *MESS '>@CALHCON> FACTOR DUE TO TWISTED VELOCITY : ' FACV ;
  2185. MESS '>@CALHCON> VELOCITY CORRECTION FACTOR : 'FACV ;
  2186. MESS '>@CALHCON> TOTAL FACT. DUE TO TWIST or RIP.: ' FACT ;
  2187. MESS '>@CALHCON> NUSS. HEATING NUMBER : ' ( IPOL 400. LTWALL1 LNUS ) ;
  2188. *MESS ' EXPERIMENTAL CRITICAL FLUX : ' FCR1 ;
  2189. MESS '>@CALHCON> CONV. COEF. (CONVECTION) : ' ( IPOL 400. LTWALL1 LH_DB ) ;
  2190. MESS '>@CALHCON> FC_DB (TWALL = 400 C ) :' ( IPOL 400. LTWALL1 LFC_DB ) ;
  2191. *
  2192. *
  2193. *
  2194. SI ( EGA TAB_1.L_SUBNB 'THOM' ) ;
  2195. LFB = LFB_TM ;
  2196. FINSI ;
  2197. *
  2198. SI ( EGA TAB_1.L_SUBNB 'THOM_CEA' ) ;
  2199. LFB = LFB_TMP ;
  2200. FINSI ;
  2201. *
  2202. SI ( EGA TAB_1.L_SUBNB 'T_JAERI' ) ;
  2203. LFB = LFB_TMJ ;
  2204. FINSI ;
  2205. *
  2206. SI ( EGA TAB_1.L_SUBNB 'JENS_LOTTES' ) ;
  2207. LFB = LFB_JL ;
  2208. FINSI ;
  2209. *
  2210. SI ( EGA TAB_1.L_SUBNB 'YIN' ) ;
  2211. LFB = LFB_YIN ;
  2212. TAB_1.CONNECT_METHOD = 'ADDITION' ;
  2213. FINSI ;
  2214. *
  2215. SI ( EXISTE TAB_1 AMPL_H ) ;
  2216. LHCONV = LHCONV * ( TAB_1 . AMPL_H ) ;
  2217. FINSI ;
  2218. *
  2219. LFCONV = ( LTWALL - LTETA ) * LHCONV ;
  2220. TITRE TAB_1.L_CONVECT 'CONVECTION FLUX' ;
  2221. EVOFC = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFCONV ;
  2222. TITRE TAB_1.L_SUBNB 'BOILING FLUX' ;
  2223. EVOFE = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFB ;
  2224. *
  2225. SI ( NON ( EXISTE TAB_1 CONNECT_METHOD ) ) ;
  2226. TAB_1.CONNECT_METHOD = 'BERG_ROH' ;
  2227. FINSI ;
  2228. *
  2229. SI ( EGA TAB_1.CONNECT_METHOD 'ADDITION' ) ;
  2230. TAB_1.L_SUBNB = 'YIN' ;
  2231. MESS '>@CALHCON> ADDITION DE FSPL ET FSCB CHOISIE ' ;
  2232. LFT = LFCONV + LFB ;
  2233. FINSI ;
  2234. *
  2235. SI ( EGA TAB_1.CONNECT_METHOD 'DIRECT' ) ;
  2236. PA_TEMPE = 10. ;
  2237. TEMPE_PA = TSAT ;
  2238. FLUX_DIC = @IPOE TEMPE_PA EVOFC ;
  2239. FLUX_DIE = @IPOE TEMPE_PA EVOFE ;
  2240. * Recherche du point d'intersection
  2241. REPETER BOUC_DIR ;
  2242. SI ( ( ABS ( FLUX_DIE - FLUX_DIC ) ) &lt;EG 1.E2 ) ;
  2243. QUITTER BOUC_DIR ;
  2244. FINSI ;
  2245. SI ( FLUX_DIE > FLUX_DIC ) ;
  2246. TEMPE_PA = TEMPE_PA - PA_TEMPE ;
  2247. PA_TEMPE = PA_TEMPE / 2. ;
  2248. FINSI ;
  2249. TEMPE_PA = TEMPE_PA + PA_TEMPE ;
  2250. FLUX_DIC = @IPOE TEMPE_PA EVOFC ;
  2251. FLUX_DIE = @IPOE TEMPE_PA EVOFE ;
  2252. FIN BOUC_DIR ;
  2253. RANGE_D = (LTWALL MASQUE 'INFE' 'SOMME' TEMPE_PA) + 1 ;
  2254. LTWALL_D = INSERER LTWALL RANGE_D TEMPE_PA ;
  2255. LFCONV_D = INSERER LFCONV RANGE_D FLUX_DIC ;
  2256. LFB_D = INSERER LFB RANGE_D FLUX_DIE ;
  2257. LM_IFLUX = LFCONV_D MASQUE 'INFERIEUR' FLUX_DIC ;
  2258. LM_SFLUX = LFB_D MASQUE 'EGSUPE' FLUX_DIE ;
  2259. LFCONVI = LFCONV_D * LM_IFLUX ;
  2260. LFBS = LFB_D * LM_SFLUX ;
  2261. LFT = LFCONVI + LFBS ;
  2262. LTWALL = LTWALL_D ;
  2263. LFCONV = LFCONV_D ;
  2264. LFB = LFB_D ;
  2265. LTETA = PROG ( DIME LTWALL_D ) * T_LOC1 ;
  2266. FINSI ;
  2267. *
  2268. SI ( EGA TAB_1.CONNECT_METHOD 'BERG_ROH' ) ;
  2269. LFCONV1 = LFCONV * LM_ITONB ;
  2270. LFCONV2 = LFCONV * LM_STONB ;
  2271. FB_ONB = IPOL TONB LTWALL LFB ;
  2272. LFB_ONB = PROG (DIME LTWALL) * FB_ONB ;
  2273. LDFB = ( LFB - LFB_ONB ) * LM_STONB ;
  2274. LF = ( LFCONV2 ** 2 ) + ( LDFB ** 2 ) ;
  2275. LF = LF ** 0.5 ;
  2276. LF = LF * LM_STONB ;
  2277. LFT = LFCONV1 + LF ;
  2278. FINSI ;
  2279. *
  2280. SI ( EGA TAB_1.CONNECT_METHOD 'JB_METHOD' ) ;
  2281. *
  2282. *liaison par flux = a Tparoi**10 + b
  2283. * LA_1 = ( LFB_ONB1 - LFB_ONB ) / (( LTONB1 ** 10 ) -
  2284. * ( LTONB ** 10 ) ) ;
  2285. * LB_1 = LFB_ONB - ( LA_1 * ( LTONB ** 10 ) ) ;
  2286. * LFPB = ( LA_1 * ( LTWALL_6 ** 10 ) ) + LB_1 ;
  2287. *
  2288. FB_ONB4 = IPOL TONB LTWALL LFB ;
  2289. FB_ONB5 = IPOL TONB LTWALL LFCONV ;
  2290. FB_ONB6 = 2.8 * FB_ONB5 ;
  2291. * EVFB_TMP = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TMP ;
  2292. EVFB_TM1 = EVOL MANU 'FLUX' LFB_TMP 'TEMPERATURE' LTWALL ;
  2293. T_ONB6 = @IPOE FB_ONB6 EVFB_TM1 FIXE ;
  2294. RANGE_6 = ( LTWALL MASQUE 'INFE' 'SOMME' T_ONB6 ) + 1 ;
  2295. LTWALL_6 = INSERER LTWALL RANGE_6 T_ONB6 ;
  2296. *
  2297. LM_ITON2 = LTWALL_6 MASQUE 'INFERIEUR' T_ONB6 ;
  2298. LM_STON2 = LTWALL_6 MASQUE 'EGSUPE' T_ONB6 ;
  2299. LM_ITON3 = LTWALL_6 MASQUE 'INFERIEUR' TONB ;
  2300. LM_STON3 = LTWALL_6 MASQUE 'EGSUPE' TONB ;
  2301. LFB_ONB4 = PROG ( DIME LTWALL_6 ) * FB_ONB4 ;
  2302. LFB_ONB6 = PROG ( DIME LTWALL_6 ) * FB_ONB6 ;
  2303. LTETA1 = PROG ( DIME LTWALL_6 ) * T_LOC1 ;
  2304. *
  2305. LHCONV1 = @ITPLT LTWALL LHCONV 'FIXE' LTWALL_6 ;
  2306. LFCONV1 = ( LTWALL_6 - LTETA1 ) * LHCONV1 ;
  2307. LFB1 = @ITPLT LTWALL LFB 'FIXE' LTWALL_6 ;
  2308. LFCONV2 = LFCONV1 * LM_ITON3 ;
  2309. LFCONV3 = LFCONV1 * LM_STON3 ;
  2310. LFCONV3 = LFCONV3 * LM_ITON2 ;
  2311. LB_1 = ( ( LFB_ONB6 ** 2 ) - ( LFCONV3 ** 2 ) ) / ( ( LFB_ONB6 - LFB_ONB4 ) ** 2 ) ;
  2312. * LB_1 = 1. ;
  2313. LDFB1 = ( LFB1 - LFB_ONB4 ) * LM_STON3 ;
  2314. LFT0 = ( LFCONV3 ** 2 ) + ( LB_1 * ( LDFB1 ** 2 ) ) ;
  2315. LFT0 = LFT0 ** 0.5 ;
  2316. LFT0 = LFT0 * LM_STON3 ;
  2317. LFT1 = LFCONV2 + LFT0 ;
  2318. FINSI ;
  2319. *
  2320. SI ( NON ( EXISTE TAB_1 PFIXTONB ) ) ;
  2321. TAB_1 . PFIXTONB = FAUX ;
  2322. FINSI ;
  2323. *
  2324. SI ( TAB_1 . PFIXTONB ) ;
  2325. F_ONB1 = IPOL TONB LTWALL LFT ;
  2326. LF_ONB1 = PROG (DIME LTWALL) * F_ONB1 ;
  2327. LHT = (LFT - LF_ONB1) / (LTWALL - LTONB) ;
  2328. LTETA_1 = LTONB - ( LF_ONB1 / LHT ) ;
  2329. MESS '>@CALHCON> LTETA_1 :' ;
  2330. TAB_1 . EV_TETA = EVOL MANU 'TEMPERATURE' LTWALL 'TEMPEAU' LTETA_1 ;
  2331. SINON ;
  2332. SI ( EGA TAB_1.CONNECT_METHOD 'JB_METHOD' ) ;
  2333. LFT = LFT1 ;
  2334. LHT = LFT1 / (LTWALL_6 - LTETA1 ) ;
  2335. LTWALL = LTWALL_6 ;
  2336. SINON ;
  2337. LHT = LFT / ( LTWALL - LTETA ) ;
  2338. FINSI ;
  2339. FINSI ;
  2340.  
  2341. TITRE ' HEAT TRANSFER COEFFICIENT ' ;
  2342. EVOCON = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LHT ;
  2343. *TITRE TAB_1.L_CONVECT 'CONVECTION FLUX' ;
  2344. *EVOFC = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFCONV ;
  2345. *TITRE TAB_1.L_SUBNB 'BOILING FLUX' ;
  2346. *EVOFE = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFB ;
  2347. TITRE ' COMBINED FLUX ' ;
  2348. EVOFT = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFT ;
  2349. *
  2350. TITRE ' COEF. D ECHANGE EN EBULLITION SOUS SATUREE, TONB :' TONB ;
  2351. *TITRE ' HEAT TRANSFER COEFFICIENT , TONB ' TONB ;
  2352. TITRE ' CHOSEN CORRELATIONS , TONB ' TONB ;
  2353.  
  2354. * modif raph/schlo pour couper l'echange au dessus du flux critique
  2355. * en regime transitoire, effectuee par R. MITTEAU le 16 fevrier 94
  2356. SI (EXISTE TAB_1 TRANSITOIRE) ;
  2357. SI TAB_1.TRANSITOIRE ;
  2358. SI (EXISTE TAB_1 FLUCRIT1 ) ;
  2359. EVBIDON1 = EVOL MANU LFT LTWALL ;
  2360. T_CRISE = @IPOE TAB_1.FLUCRIT1 EVBIDON1 ;
  2361. H_CRISE = @IPOE T_CRISE EVOCON ;
  2362. RANGENTI = ( LTWALL MASQUE 'INFE' 'SOMME' T_CRISE ) + 1 ;
  2363. LTWALL3 = INSERER LTWALL RANGENTI T_CRISE ;
  2364. LHT2 = INSERER LHT RANGENTI H_CRISE ;
  2365. LFT2 = INSERER LFT RANGENTI TAB_1.FLUCRIT1 ;
  2366. MASQ1 = LFT2 MASQUE EGINFE TAB_1.FLUCRIT1 ;
  2367. MASQ2 = LFT2 MASQUE SUPERIEUR TAB_1.FLUCRIT1 ;
  2368. LHT3 = (LHT2 * MASQ1 ) + MASQ2 ;
  2369. LFT3 = (LFT2 * MASQ1 ) + MASQ2 ;
  2370. TITRE ' HEAT TRANSFER COEFFICIENT ' ;
  2371. EVOCON = EVOL MANU 'TEMPERATURE' LTWALL3 'CONVECTION' LHT3 ;
  2372. TITRE ' COMBINED FLUX ' ;
  2373. EVOFT = EVOL MANU 'TEMPERATURE' LTWALL3 'CONVECTION' LFT3 ;
  2374. FINSI ;
  2375. FINSI ;
  2376. FINSI ;
  2377. *
  2378. TAB_1.T_SAT = TSAT ;
  2379. TAB_1.V_TONB = TONB ;
  2380. TAB_1.ECONVEC1 = EVOCON ;
  2381. TAB_1.EVOFE1 = EVOFE ;
  2382. *
  2383. TAC1 = TABLE ;
  2384. TAC1.1 = 'MARQ CROI REGU' ;
  2385. TAC1.2 = 'MARQ PLUS REGU' ;
  2386. TAC1.3 = 'MARQ ETOI REGU' ;
  2387. TAC1.4 = 'MARQ LOSA REGU' ;
  2388. TAC1.5 = 'MARQ CARR REGU' ;
  2389. TAC1.6 = 'MARQ TRIB REGU' ;
  2390. *
  2391. TAC2 = TABLE ;
  2392. TAC2.1 = 'MARQ CARR REGU' ;
  2393. TAC2.2 = 'MARQ LOSA REGU' ;
  2394. TAC2.3 = 'MARQ TRIA REGU' ;
  2395. TAC2.4 = 'MARQ TRIB REGU' ;
  2396. *
  2397. SI ( NON ( EXISTE TAB_1 C_TRACE ) ) ;
  2398. TAB_1.C_TRACE = FAUX ;
  2399. FINSI ;
  2400. *
  2401. SI L1TRAC ;
  2402. SI TAB_1.C_TRACE ;
  2403. SI ( EGA TAB_1.L_SUBNB 'YIN' ) ;
  2404. TITRE 'CONVECTIVE AND SUBCOOLED BOILING CORRELATIONS' ;
  2405. DESSIN ( EVOFC_DB ET EVOFC_ST ET EVOFC_P ET EVOFB_T1 ET EVOFB_JL ET EVFB_YIN) XBOR 0. 400. YBOR 0. 7.E7 LEGE TAC1 ;
  2406. SINON ;
  2407. TITRE 'CONVECTIVE AND SUBCOOLED BOILING CORRELATIONS' ;
  2408. DESSIN ( EVOFC_DB ET EVOFC_ST ET EVOFC_P ET EVOFB_T1 ET EVOFB_JL) XBOR 0. 400. YBOR 0. 7.E7 LEGE TAC1 ;
  2409. TAB_1.EVOFC_D1 = EVOFC_DB ;
  2410. TAB_1.EVOFC_S1 = EVOFC_ST ;
  2411. TAB_1.EVOFC_P1 = EVOFC_P ;
  2412. TAB_1.EVOFC_M1 = EVOFC_JB ;
  2413. TAB_1.EVOFB_T2 = EVOFB_T1 ;
  2414. TAB_1.EVOFB_J1 = EVOFB_JL ;
  2415. FINSI ;
  2416. FINSI ;
  2417. SI ( TAB_1 . PFIXTONB ) ;
  2418. DESSIN TAB_1.EV_TETA XBOR T_LOC1 400. YBOR 0. 150000. MIMA ;
  2419. FINSI ;
  2420. DESSIN ( EVOFC ET TAB_1.EVOFE1 ET EVOFT ) XBOR 0. 400. YBOR 0. 7.E7 MIMA LEGE TAC2 ;
  2421. DESSIN TAB_1.ECONVEC1 XBOR 0. 400. YBOR 0. 700000. MIMA ;
  2422. FINSI ;
  2423. TAB_1.EVOFC1 = EVOFC ;
  2424. TAB_1.EVOFT1 = EVOFT ;
  2425. *
  2426. SI (NIVEAU >EG 4) ;
  2427. MESS '-----------------------------------> exit from @CALHCON ';
  2428. FINSI ;
  2429.  
  2430. FINPROC ;
  2431. **** @CALHRAY
  2432. DEBPROC @CALHRAY TAB1*TABLE ;
  2433. MESS ' ';
  2434. *
  2435. * !!! R. MITTEAU !!! attention, procedure standard
  2436. *
  2437. * un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
  2438. * pour les mises a jour
  2439. *
  2440. *-------------------------------------------------------------------*
  2441. * *
  2442. * COEFFICIENT D ECHANGE TENANT COMPTE *
  2443. * DU RAYONNEMENT *
  2444. * *
  2445. *-------------------------------------------------------------------*
  2446. *23456789012345678901234567890123456789012345678901234567890123456789012
  2447. * 1 2 3 4 5 6 7
  2448. *
  2449. * --- entrees
  2450. *
  2451. TZERO = TAB1.'TEMP_RAYO' ;
  2452. EPS1 = TAB1.'EMISSIVITE' ;
  2453. AB_2 = TAB1.'ABSORPTION' ;
  2454. NIVEAU1 = TAB1.'NIVEAU' ;
  2455. LTRAC = TAB1.'TRAC_GRAPHE' ;
  2456.  
  2457. SI (NIVEAU1 >EG 4 ) ;
  2458. MESS '-----------------------------------> calling @CALHRAY ';
  2459. FINSI ;
  2460.  
  2461. LTEMR = PROG -5000. 0. 50. 100. 200. 300. 400. 500. 600. 700. 800. 900. 1000. 1100. 1200. 1300. 1400. 1500. 1600. 1700. 1800. 1900. 2000. 2100. 2200. 2300. 2400. 2500. 2600. 2700. 2800. 2900. 3000. 3100. 3200. 3300. 3400. 3500. 3600. 3700. 3800. 3900. 2.E4 ;
  2462. SIGMA =5.67E-8 ;
  2463. TZK = 273.3 ;
  2464. MESS '>@CALHRAY> STEFAN CONSTANT : ' SIGMA ;
  2465. MESS '>@CALHRAY> TZERO DEG. C : ' TZERO ;
  2466. MESS '>@CALHRAY> EMISSIVITY : ' EPS1 ;
  2467. MESS '>@CALHRAY> ABSORPTION : ' AB_2 ;
  2468. TZERK = TZERO + TZK ;
  2469. * MESS ' TEMP H FR ' ;
  2470. LISTH = PROG ;
  2471. LISFE = PROG ;
  2472. IH1 = 0 ;
  2473. REPETER CAH1 ( DIME LTEMR ) ;
  2474. IH1 = IH1 + 1 ;
  2475. TEMP = EXTR LTEMR IH1 ;
  2476. TEMK = TEMP + TZK ;
  2477. EPSEQ = (( 1./EPS1 ) + (1./AB_2) - 1.) ** -1 ;
  2478. * FE = SIGMA * ((EPS1 * ( TEMK ** 4 )) - (AB_2 * ( TZERK ** 4 )));
  2479. FE = SIGMA * EPSEQ *( ( TEMK ** 4 ) - ( TZERK ** 4 ) ) ;
  2480. * H1 = TEMK ** 3 ;
  2481. * H2 = ( TEMK ** 2 ) * ( TZERK ) ;
  2482. * H3 = ( TEMK ) * ( TZERK ** 2 ) ;
  2483. * H4 = TZERK ** 3 ;
  2484. * H = SIGMA * EPS1 * ( H1 + H2 + H3 + H4 ) ;
  2485. SI ( EGA TEMK TZERK 1. ) ;
  2486. H = FE / 1. ;
  2487. SINON ;
  2488. H = FE / ( TEMK - TZERK ) ;
  2489. FINSI ;
  2490. LISTH = LISTH ET ( PROG H ) ;
  2491. LISFE = LISFE ET ( PROG FE ) ;
  2492. * MESS TEMP H FE ;
  2493. FIN CAH1 ;
  2494. TITRE '>@CALHRAY> COEFFICIENT ECHANGE DE RAYONNEMENT ' ;
  2495. ERAYON = EVOL MANU 'TEMPERATURE' LTEMR 'COEFFICIENT ECHANGE' LISTH ;
  2496. TITRE '>@CALHRAY> FLUX DE CHALEUR RAYONNEE ' ;
  2497. EVOFE = EVOL MANU 'TEMPERATURE' LTEMR 'RAYONNEMENT' LISFE ;
  2498. TAB1.EVORAYT1 = EVOFE ;
  2499. TAB1.EHRAYON1 = ERAYON ;
  2500. *
  2501. SI LTRAC ;
  2502. DESSIN EVOFE XBOR 0. 3900. YBOR 0. 4.E6 ;
  2503. DESSIN ERAYON XBOR 0. 3900. YBOR 0. 1500. ;
  2504. FINSI;
  2505. *
  2506. SI (NIVEAU1 >EG 4 ) ;
  2507. MESS '-----------------------------------> exiting @CALHRAY ';
  2508. FINSI ;
  2509. FINPROC ERAYON ;
  2510. **** @CALOR
  2511. 'DEBPROC' @CALOR TAB1*'TABLE ' PUI1*FLOTTANT ;
  2512. MESS ' ' ;
  2513. * pour le calcul de la puissance voir CFLUX
  2514. *
  2515. VIN = TAB1 . V_IN ;
  2516. TIN = TAB1 . T_IN ;
  2517. CPF = @IPOE TIN TAB1.ETCPF ;
  2518. SI ( NON ( EXISTE TAB1 V_EMDOTI)) ;
  2519. RHOIN = @IPOE TIN TAB1.ETRHOF ;
  2520. NNUIN = @IPOE TIN TAB1.ETNNU ;
  2521. GIN = RHOIN * VIN ;
  2522. SI ( EXISTE TAB1 RIP_FLOWS ) ;
  2523. EMDOTI = GIN * ( TAB1 . RIP_FLOWS ) ;
  2524. SINON ;
  2525. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  2526. TAB1.HYP_SM = ( TAB1.LARG_CANAL * TAB1.HMIN_CANAL ) + ( 2. * ( TAB1.LARG_ESP * TAB1.HFIN ) ) ;
  2527. EMDOTI = GIN * TAB1.HYP_SM ;
  2528. SINON ;
  2529. PI = 3.14159 ;
  2530. DIAM1 = TAB1 . D_MAQUETTE ;
  2531. TTAPE = TAB1 . T_TAPE ;
  2532. EMDOTI = GIN * ( ( PI * DIAM1 * DIAM1 / 4. ) - ( DIAM1 * TTAPE) ) ;
  2533. FINSI ;
  2534. FINSI ;
  2535. TAB1.V_EMDOTI = EMDOTI ;
  2536. SINON ;
  2537. EMDOTI = TAB1.V_EMDOTI ;
  2538. FINSI ;
  2539. *
  2540. * Modif jb 01/04/95
  2541. * Possibilite de creer une procedure calculant
  2542. * la section de passage
  2543. *SI ( NON ( EXISTE TAB1 SP ) ) ;
  2544. * SI ( EXISTE TAB1 RIP_FLOWS ) ;
  2545. * TAB1.SP = TAB1.RIP_FLOWS ;
  2546. * FINSI ;
  2547. * SI ( EGA TAB1.HYPERVAP VRAI ) ;
  2548. * TAB1.HYP_SM = ( TAB1.LARG_CANAL * TAB1.HMIN_CANAL ) +
  2549. * ( 2. * ( TAB1.LARG_ESP * TAB1.HFIN ) ) ;
  2550. * TAB1.SP = TAB1.HYP_SM ;
  2551. * SINON ;
  2552. * PI = 3.14159 ;
  2553. * DIAM1 = TAB1 . D_MAQUETTE ;
  2554. * TTAPE = TAB1 . T_TAPE ;
  2555. * TAB1.SP = ( PI * DIAM1 * DIAM1 / 4. ) - ( DIAM1 * TTAPE) ;
  2556. * FINSI ;
  2557. *EMDOTI = GIN * TAB1.SP ;
  2558. *
  2559. DELT = PUI1 / (EMDOTI * CPF) ;
  2560. TOUT = TIN + DELT ;
  2561. TAB1.TEMPE_OUT = TOUT ;
  2562. SI ( EGA TAB1.HYPERVAP VRAI ) ;
  2563. TAB1.'T_LOCAL' = TIN ;
  2564. TAB1.'T_MOY' = TIN ;
  2565. SINON ;
  2566. TAB1.'T_LOCAL' = TIN + ((TOUT - TIN) * TAB1.X_LOCAL) ;
  2567. TAB1.'T_MOY' = (TIN + TOUT) / 2. ;
  2568. FINSI ;
  2569. MESS '>@CALOR> TIN :' TIN ;
  2570. MESS '>@CALOR> TOUT DT :' TOUT DELT ;
  2571. MESS '>@CALOR> TMOY :' TAB1.'T_MOY' ;
  2572. MESS '>@CALOR> T_LOCAL :' TAB1.'T_LOCAL' ;
  2573. FINPROC ;
  2574. **** @CAPKPC
  2575. DEBPROC @CAPKPC EV_1*EVOLUTION PC_1*FLOTTANT D_1*FLOTTANT FL_INC*FLOTTANT NIV1/ENTIER;
  2576. *
  2577. * !!! R. MITTEAU !!! attention, procedure standard
  2578. *
  2579. * un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
  2580. * pour les mises a jour
  2581. *
  2582. * calcul du peaking factor correspondant au pourcentage PC_1
  2583. * FL_INC flux incident moyen
  2584. * EV_1 evolution donnant le flux en paroi d eau
  2585. SI (NON (EXISTE NIV1));
  2586. MESS '---------------------------------> calling @CAPKPC';
  2587. SINON;
  2588. SI (NIV1 >EG 4);
  2589. MESS '---------------------------------> calling @CAPKPC';
  2590. FINSI;
  2591. FINSI;
  2592. P_X_1 = EXTR EV_1 'ABSC' 1 ;
  2593. P_Y_1 = EXTR EV_1 'ORDO' 1 ;
  2594. N1 = DIME P_X_1 ;
  2595. VINT0 = MAXI (INTG ( EVOL MANU P_X_1 P_Y_1 )) ;
  2596. SI ( PC_1 >EG 1. ) ;
  2597. MESS ' >>>>> CAPKPC POURCENTAGE SUPERIEUR A 1 ' ;
  2598. ERRE ' >>>>> CAPKPC POURCENTAGE SUPERIEUR A 1 ' ;
  2599. FINSI ;
  2600. VA_1 = PC_1 * VINT0 ;
  2601. VINT1 = VINT0 ;
  2602. REPETER B__1 N1 ;
  2603. I_1 = DIME P_X_1 ;
  2604. P_X_2 = ENLE P_X_1 I_1 ;
  2605. P_Y_2 = ENLE P_Y_1 I_1 ;
  2606. VINT2 = MAXI (INTG ( EVOL MANU P_X_2 P_Y_2 )) ;
  2607. SI( VINT2 &lt;EG VA_1 ) ;
  2608. X_1 = EXTR P_X_1 I_1 ;
  2609. X_2 = EXTR P_X_1 (I_1 - 1) ;
  2610. Y_1 = EXTR P_Y_1 I_1 ;
  2611. Y_2 = EXTR P_Y_1 (I_1 - 1) ;
  2612. PENTE = (Y_1 - Y_2) / (X_1 - X_2) ;
  2613. DELTA = Y_2 ** 2 + ( 2. * PENTE *( VA_1 - VINT2 )) ;
  2614. SI ( DELTA < 0. ) ;
  2615. MESS ' >>>>> CAPKPC y a un truc DELTA < 0. ' ;
  2616. MESS ' >>>>> CAPKPC VINT2 VINT1 VA_1 ' VINT2 VINT1 VA_1 ;
  2617. MESS ' >>>>> CAPKPC Y_2 X_2 Y_1 X_1 ' Y_2 X_2 Y_1 X_1 ;
  2618. FINSI ;
  2619. * X_11 = X_2 + ((X_1 - X_2) / ( VINT1 - VINT2 )
  2620. * * ( VA_1 - VINT2 )) ;
  2621. RDELT = DELTA ** 0.5 ;
  2622. DX_11 = ( (-1. * Y_2) + RDELT ) / PENTE ;
  2623. X_11 = X_2 + DX_11 ;
  2624. SI ( (DX_11 * ( X_11 - X_1)) > 0. ) ;
  2625. MESS ' >>>>> CAPKPC y a un truc X_11 X_1 X_2 ' X_11 X_1 X_2;
  2626. MESS ' >>>>> CAPKPC VINT2 VINT1 VA_1 ' VINT2 VINT1 VA_1 ;
  2627. MESS ' >>>>> CAPKPC Y_2 X_2 Y_1 X_1 ' Y_2 X_2 Y_1 X_1 ;
  2628. MESS ' >>>>> CAPKPC PENTE DELTA RDELT' PENTE DELTA RDELT ;
  2629. FINSI ;
  2630. QUITTER B__1 ;
  2631. FINSI ;
  2632. P_X_1 = P_X_2 ;
  2633. P_Y_1 = P_Y_2 ;
  2634. VINT1 = VINT2 ;
  2635. FIN B__1 ;
  2636. FL_PC = VINT0 / X_11 ;
  2637. AL_1 = 2.* X_11 / D_1 ;
  2638. PKF_1 = FL_PC / FL_INC ;
  2639.  
  2640. SI (NON (EXISTE NIV1));
  2641. MESS '---------------------------------> exiting @CAPKPC';
  2642. SINON;
  2643. SI (NIV1 >EG 4);
  2644. MESS '---------------------------------> exiting @CAPKPC';
  2645. FINSI;
  2646. FINSI;
  2647. FINPROC AL_1 PKF_1 ;
  2648. **** @CBGMV
  2649. DEBPROC @CBGMV BXG*CHPOINT BYG*CHPOINT BZG*CHPOINT TAB1*TABLE ;
  2650. *
  2651. ********************************************************************
  2652. * Procedure de changement de base. On passe de la base cartesienne *
  2653. * globale de la machine definie par l'axe du tore dirige suivant *
  2654. * Z et l'axe X situe dans le plan median entre deux bobines a la *
  2655. * base cartesienne du maillage. *
  2656. * Trois cas sont etudies : 3D, 2D en coupe Phi constant et 2D en *
  2657. * coupe Theta constant. Alain MOAL (Decembre 1995-Janvier 1996) *
  2658. ********************************************************************
  2659. *
  2660. *--------------- VARIABLES D'ENTREE :
  2661. SI ((VALEUR DIME) EGA 2) ;
  2662. IPLAN = TAB1.<PLAN ;
  2663. SI (EGA IPLAN 'PHICONS') ;
  2664. CT0 = TAB1.<CENTRE_TORE ;
  2665. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  2666. P1 = TAB1.<POINT_SUR_OBJET ;
  2667. FINSI ;
  2668. SI (EGA IPLAN 'THECONS') ;
  2669. THETA0 = TAB1.<THETA0 ;
  2670. CP = TAB1.CENTRE_PLASMA ;
  2671. RP = TAB1.<RP ;
  2672. HP = TAB1.<HP ;
  2673. FINSI ;
  2674. SINON ;
  2675. CT0 = TAB1.<CENTRE_TORE ;
  2676. CT1 = TAB1.<POINT_SUR_AXE_TORE ;
  2677. P1 = TAB1.<POINT_SUR_OBJET ;
  2678. FINSI ;
  2679. ANGPHI0 = TAB1.<ANG_PHI0 ;
  2680. *------------------------------------
  2681. *
  2682. DIM0 = VALEUR DIME ;
  2683. SI (DIM0 EGA 2) ;
  2684. FINSI ;
  2685. *
  2686. SI (((DIM0 EGA 2) ET (EGA IPLAN 'PHICONS')) OU (DIM0 EGA 3)) ;
  2687. X0 Y0 Z0 = COOR CT0 ;
  2688. X1 Y1 Z1 = COOR CT1 ;
  2689. XP1 YP1 ZP1 = COOR P1 ;
  2690. *
  2691. * ---- Calcul des coordonnees du point P0, projection du point P1 de
  2692. * ---- l'objet dans le plan orthogonal a l'axe du tore en CT0.
  2693. A = X1 - X0 ;
  2694. B = Y1 - Y0 ;
  2695. C = Z1 - Z0 ;
  2696. *
  2697. SI (A EGA 0.) ;
  2698. SI (B EGA 0.) ;
  2699. XP0 = XP1 ;
  2700. YP0 = YP1 ;
  2701. ZP0 = Z0 ;
  2702. FINSI ;
  2703. SI (C EGA 0.) ;
  2704. XP0 = XP1 ;
  2705. YP0 = Y0 ;
  2706. ZP0 = ZP1 ;
  2707. FINSI ;
  2708. SI ((B NEG 0.) ET (C NEG 0.)) ;
  2709. XP0 = XP1 ;
  2710. YP0 = (-1.*B*C*ZP1 + (C*C*YP1) + (B*B*Y0) + (B*C*Z0)) /(B*B + (C*C)) ;
  2711. ZP0 = (B*ZP1 - (C*YP1) + (C*(Y0+Z0)))/(B+C);
  2712. FINSI ;
  2713. SINON ;
  2714. AUX1 = A / (A*A + (B*B) + (C*C)) ;
  2715. AUX2 = (B