Télécharger cfpflu.dgibi

Retour à la liste

Numérotation des lignes :

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