Télécharger couplage_TH1D_Th3D.dgibi

Retour à la liste

Numérotation des lignes :

  1. * fichier : couplage_TH1D_Th3D.dgibi
  2. ************************************************************************
  3. ************************************************************************
  4. 'OPTION' 'ECHO' 0 ;
  5. * From ~/nlin/sources_dev_new/util_proc :
  6. *BEGINPROCEDUR append
  7. ************************************************************************
  8. * NOM : APPEND
  9. * DESCRIPTION : Rajoute :
  10. * - un entier à un listentier
  11. * - un réel à un listreel
  12. * - un objet (liste, evolution, matrice ou chpoint)
  13. * à un indice de table ('MOT' ou 'ENTIER')
  14. * * si l'indice n'existe pas
  15. * * 'ET' si l'indice existe
  16. *
  17. *
  18. *
  19. * LANGAGE : GIBIANE-CAST3M
  20. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  21. * mél : gounand@semt2.smts.cea.fr
  22. **********************************************************************
  23. * VERSION : v1, 10/09/2004, version initiale
  24. * HISTORIQUE : v1, 10/09/2004, création
  25. * HISTORIQUE :
  26. * HISTORIQUE :
  27. ************************************************************************
  28. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  29. * en cas de modification de ce sous-programme afin de faciliter
  30. * la maintenance !
  31. ************************************************************************
  32. *
  33. *
  34. 'DEBPROC' APPEND ;
  35. 'ARGUMENT' tab/'TABLE' ;
  36. 'SI' ('EXISTE' tab) ;
  37. 'ARGUMENT' itab/'MOT' ;
  38. 'SI' ('NON' ('EXISTE' itab)) ;
  39. 'ARGUMENT' itab*'ENTIER' ;
  40. 'FINSI' ;
  41. lobj = FAUX ;
  42. 'SI' ('NON' lobj) ;
  43. 'ARGUMENT' lr/'LISTREEL' ;
  44. 'SI' ('EXISTE' lr) ;
  45. obj = lr ; lobj = VRAI ;
  46. 'FINSI' ;
  47. 'FINSI' ;
  48. 'SI' ('NON' lobj) ;
  49. 'ARGUMENT' le/'LISTENTI' ;
  50. 'SI' ('EXISTE' le) ;
  51. obj = le ; lobj = VRAI ;
  52. 'FINSI' ;
  53. 'FINSI' ;
  54. 'SI' ('NON' lobj) ;
  55. 'ARGUMENT' lev/'EVOLUTION' ;
  56. 'SI' ('EXISTE' lev) ;
  57. obj = lev ; lobj = VRAI ;
  58. 'FINSI' ;
  59. 'FINSI' ;
  60. 'SI' ('NON' lobj) ;
  61. 'ARGUMENT' lm/'MAILLAGE' ;
  62. 'SI' ('EXISTE' lm) ;
  63. obj = lm ; lobj = VRAI ;
  64. 'FINSI' ;
  65. 'FINSI' ;
  66. 'SI' ('NON' lobj) ;
  67. 'ARGUMENT' chpo/'CHPOINT' ;
  68. 'SI' ('EXISTE' chpo) ;
  69. obj = chpo ; lobj = VRAI ;
  70. 'FINSI' ;
  71. 'FINSI' ;
  72. 'SI' ('NON' lobj) ;
  73. 'ARGUMENT' rig/'RIGIDITE' ;
  74. 'SI' ('EXISTE' rig) ;
  75. obj = rig ; lobj = VRAI ;
  76. 'FINSI' ;
  77. 'FINSI' ;
  78. 'SI' ('NON' lobj) ;
  79. 'ARGUMENT' matk/'MATRIK' ;
  80. 'SI' ('EXISTE' matk) ;
  81. obj = matk ; lobj = VRAI ;
  82. 'FINSI' ;
  83. 'FINSI' ;
  84. 'SI' ('NON' lobj) ;
  85. cherr = 'CHAINE'
  86. 'Il faut fournir un objet liste, evolution, matrice ou chpoint.'
  87. ;
  88. 'ERREUR' cherr ;
  89. 'FINSI' ;
  90. 'SI' ('EXISTE' tab itab) ;
  91. tab . itab = 'ET' (tab . itab) obj ;
  92. 'SINON' ;
  93. tab . itab = obj ;
  94. 'FINSI' ;
  95. 'RESPRO' tab ;
  96. 'FINSI' ;
  97. 'ARGUMENT' lenti/'LISTENTI' ;
  98. 'ARGUMENT' lreel/'LISTREEL' ;
  99. 'SI' ('EXISTE' lenti) ;
  100. 'ARGUMENT' enti*'ENTIER' ;
  101. lenti = 'ET' lenti ('LECT' enti) ;
  102. 'RESPRO' lenti ;
  103. 'FINSI' ;
  104. 'SI' ('EXISTE' lreel) ;
  105. 'ARGUMENT' reel*'FLOTTANT' ;
  106. lreel = 'ET' lreel ('PROG' reel) ;
  107. 'RESPRO' lreel ;
  108. 'FINSI' ;
  109. *
  110. * End of procedure file APPEND
  111. *
  112. 'FINPROC' ;
  113. *ENDPROCEDUR append
  114. *BEGINPROCEDUR errrel
  115. ************************************************************************
  116. * NOM : ERRREL
  117. * DESCRIPTION : Calcul d'une erreur relative
  118. *
  119. *
  120. *
  121. * LANGAGE : GIBIANE-CAST3M
  122. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  123. * mél : gounand@semt2.smts.cea.fr
  124. **********************************************************************
  125. * VERSION : v1, 23/04/2003, version initiale
  126. * HISTORIQUE : v1, 23/04/2003, création
  127. * HISTORIQUE :
  128. * HISTORIQUE :
  129. ************************************************************************
  130. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  131. * en cas de modification de ce sous-programme afin de faciliter
  132. * la maintenance !
  133. ************************************************************************
  134. *
  135. *
  136. 'DEBPROC' ERRREL ;
  137. 'ARGUMENT' val*'FLOTTANT' ;
  138. 'ARGUMENT' valref*'FLOTTANT' ;
  139. *
  140. 'SI' ('<' ('ABS' valref) 1.D-10) ;
  141. echref = 1.D0 ;
  142. 'SINON' ;
  143. echref = valref ;
  144. 'FINSI' ;
  145. *
  146. errabs = 'ABS' ('/' ('-' val valref) echref);
  147. *
  148. 'RESPRO' errabs ;
  149. *
  150. * End of procedure file ERRREL
  151. *
  152. 'FINPROC' ;
  153. *ENDPROCEDUR errrel
  154. *BEGINPROCEDUR exmomod
  155. ************************************************************************
  156. * NOM : EXMOMOD
  157. * DESCRIPTION : Extraction d'un mot d'un listmots
  158. *
  159. *
  160. *
  161. * LANGAGE : GIBIANE-CAST3M
  162. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  163. * mél : gounand@semt2.smts.cea.fr
  164. **********************************************************************
  165. * VERSION : v1, 23/06/2003, version initiale
  166. * HISTORIQUE : v1, 23/06/2003, création
  167. * HISTORIQUE :
  168. * HISTORIQUE :
  169. ************************************************************************
  170. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  171. * en cas de modification de ce sous-programme afin de faciliter
  172. * la maintenance !
  173. ************************************************************************
  174. *
  175. *
  176. 'DEBPROC' EXMOMOD ;
  177. 'ARGUMENT' lm*'LISTMOTS' i*'ENTIER' ;
  178. j = 'DIME' lm ;
  179. k = '+' (MODULO ('-' i 1) j) 1 ;
  180. lemot = 'EXTRAIRE' lm k ;
  181. * Usage de l'opérateur text pour éviter que lemot
  182. * ne soit interprété comme un opérateur
  183. 'RESPRO' 'TEXTE' lemot ;
  184. *
  185. * End of procedure file EXMOMOD
  186. *
  187. 'FINPROC' ;
  188. *ENDPROCEDUR exmomod
  189. *BEGINPROCEDUR formar
  190. ************************************************************************
  191. * NOM : FORMAR
  192. * DESCRIPTION : formate un réel de facon courte
  193. * pratique pour les noms de
  194. * sauvegarde
  195. * Exemples :
  196. * 'MESSAGE' ('CHAINE' (formar 2.9e5 1)) ;
  197. * 2.9E5
  198. * 'MESSAGE' ('CHAINE' (formar -2.9e5 1)) ;
  199. * -2.9E5
  200. * 'MESSAGE' ('CHAINE' (formar 2.9e-5 1)) ;
  201. * 2.9E-5
  202. * 'MESSAGE' ('CHAINE' (formar -2.9e-5 1)) ;
  203. * -2.9E-5
  204. * 'MESSAGE' ('CHAINE' (formar 2.9 1)) ;
  205. * 2.9
  206. * 'MESSAGE' ('CHAINE' (formar -2.9 1)) ;
  207. * -2.9
  208. * 'MESSAGE' ('CHAINE' (formar 0 1)) ;
  209. * 0
  210. * 'MESSAGE' ('CHAINE' (formar 0 1)) ;
  211. * 0
  212. * 'MESSAGE' ('CHAINE' (formar 2.9e5 0)) ;
  213. * 3E5
  214. * 'MESSAGE' ('CHAINE' (formar -2.9e5 0)) ;
  215. * -3E5
  216. * 'MESSAGE' ('CHAINE' (formar 2.9e-5 0)) ;
  217. * 3E-5
  218. * 'MESSAGE' ('CHAINE' (formar -2.9e-5 0)) ;
  219. * -3E-5
  220. * 'MESSAGE' ('CHAINE' (formar 2.9 0)) ;
  221. * 3
  222. * 'MESSAGE' ('CHAINE' (formar -2.9 0)) ;
  223. * -3
  224. * 'MESSAGE' ('CHAINE' (formar 0 0)) ;
  225. * 0
  226. * 'MESSAGE' ('CHAINE' (formar 0 0)) ;
  227. * 0
  228. *
  229. *
  230. *
  231. * LANGAGE : GIBIANE-CAST3M
  232. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  233. * mél : gounand@semt2.smts.cea.fr
  234. **********************************************************************
  235. * VERSION : v1, 18/02/2003, version initiale
  236. * HISTORIQUE : v1, 18/02/2003, création
  237. * HISTORIQUE :
  238. * HISTORIQUE :
  239. ************************************************************************
  240. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  241. * en cas de modification de ce sous-programme afin de faciliter
  242. * la maintenance !
  243. ************************************************************************
  244. *
  245. *
  246. 'DEBPROC' FORMAR ;
  247. 'ARGUMENT' fl*'FLOTTANT' ;
  248. 'ARGUMENT' vir/'ENTIER ' ;
  249. 'SI' ('NON' ('EXISTE' vir)) ;
  250. vir = 1 ;
  251. 'SINON' ;
  252. 'SI' ('<' vir 0) ;
  253. 'ERREUR' 'fournir un entier positif' ;
  254. 'FINSI' ;
  255. 'FINSI' ;
  256. 'SI' ('<' ('ABS' fl) 10.D-100) ;
  257. chfl = 'CHAINE' '0' ;
  258. 'SINON' ;
  259. *! sans le 1.D-10, ca ne fonctionne pas
  260. *! qd on entre pile poil une puissance de 10
  261. lfl = LOG10 ('ABS' fl) ;
  262. * lfl = '+' (LOG10 ('ABS' fl)) 1.D-10 ;
  263. slfl = 'SIGNE' ('ENTIER' lfl) ;
  264. 'SI' ('EGA' slfl 1) ;
  265. elfl = 'ENTIER' lfl ;
  266. 'SINON' ;
  267. elfl = '-' ('ENTIER' lfl) 1 ;
  268. 'FINSI' ;
  269. man = '/' fl ('**' 10.D0 elfl) ;
  270. *
  271. * Une verrue pour des histoires de précision...
  272. *
  273. 'SI' ('EGA' man 10.D0 ('**' 10.D0 ('*' vir -1.D0))) ;
  274. man = '/' man 10.D0 ;
  275. elfl = '+' elfl 1 ;
  276. 'FINSI' ;
  277. *
  278. sman = 'SIGNE' man ;
  279. 'SI' ('EGA' sman 1) ;
  280. fman = 'CHAINE' '(F' ('+' vir 2) '.0' vir ')' ;
  281. 'SINON' ;
  282. fman = 'CHAINE' '(F' ('+' vir 3) '.0' vir ')' ;
  283. 'FINSI' ;
  284. 'SI' ('NEG' vir 0) ;
  285. 'SI' ('NEG' elfl 0) ;
  286. chfl = 'CHAINE' 'FORMAT' fman man 'E' elfl ;
  287. 'SINON' ;
  288. chfl = 'CHAINE' 'FORMAT' fman man ;
  289. 'FINSI' ;
  290. 'SINON' ;
  291. man2 = 'ENTIER' ('+' man ('*' 0.5D0 sman)) ;
  292. 'SI' ('NEG' elfl 0) ;
  293. chfl = 'CHAINE' man2 'E' elfl ;
  294. 'SINON' ;
  295. chfl = 'CHAINE' man2 ;
  296. 'FINSI' ;
  297. 'FINSI' ;
  298. 'FINSI' ;
  299. 'RESPRO' chfl ;
  300. *
  301. * End of procedure file FORMAR
  302. *
  303. 'FINPROC' ;
  304. *ENDPROCEDUR formar
  305. *BEGINPROCEDUR log10
  306. ************************************************************************
  307. * NOM : LOG10
  308. * DESCRIPTION : Log_10
  309. *
  310. *
  311. *
  312. * LANGAGE : GIBIANE-CAST3M
  313. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  314. * mél : gounand@semt2.smts.cea.fr
  315. **********************************************************************
  316. * VERSION : v1, 18/02/2003, version initiale
  317. * HISTORIQUE : v1, 18/02/2003, création
  318. * HISTORIQUE :
  319. * HISTORIQUE :
  320. ************************************************************************
  321. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  322. * en cas de modification de ce sous-programme afin de faciliter
  323. * la maintenance !
  324. ************************************************************************
  325. *
  326. *
  327. 'DEBPROC' LOG10 ;
  328. 'ARGUMENT' fl/'FLOTTANT' ;
  329. 'ARGUMENT' lr/'LISTREEL' ;
  330. 'ARGUMENT' cp/'CHPOINT ' ;
  331. 'ARGUMENT' cm/'MCHAML ' ;
  332. 'SI' ('EXISTE' fl) ;
  333. 'RESPRO' ('/' ('LOG' fl) ('LOG' 10.D0)) ;
  334. 'FINSI' ;
  335. 'SI' ('EXISTE' lr) ;
  336. 'RESPRO' ('/' ('LOG' lr) ('LOG' 10.D0)) ;
  337. 'FINSI' ;
  338. 'SI' ('EXISTE' cp) ;
  339. 'RESPRO' ('/' ('LOG' cp) ('LOG' 10.D0)) ;
  340. 'FINSI' ;
  341. 'SI' ('EXISTE' cm) ;
  342. 'RESPRO' ('/' ('LOG' cm) ('LOG' 10.D0)) ;
  343. 'FINSI' ;
  344. *
  345. * End of procedure file LOG10
  346. *
  347. 'FINPROC' ;
  348. *ENDPROCEDUR log10
  349. *BEGINPROCEDUR modulo
  350. ************************************************************************
  351. * NOM : MODULO
  352. * DESCRIPTION : Calcule un entier modulo un autre...
  353. *
  354. *
  355. *
  356. * LANGAGE : GIBIANE-CAST3M
  357. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  358. * mél : gounand@semt2.smts.cea.fr
  359. **********************************************************************
  360. * VERSION : v1, 15/10/2002, version initiale
  361. * HISTORIQUE : v1, 15/10/2002, création
  362. * HISTORIQUE :
  363. * HISTORIQUE :
  364. ************************************************************************
  365. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  366. * en cas de modification de ce sous-programme afin de faciliter
  367. * la maintenance !
  368. ************************************************************************
  369. *
  370. *
  371. 'DEBPROC' MODULO ;
  372. 'ARGUMENT' i*'ENTIER' j*'ENTIER' ;
  373. 'SI' ('EGA' j 0) ;
  374. 'MESSAGE' 'Impossible de faire modulo 0' ;
  375. 'ERREUR' 5 ;
  376. 'SINON' ;
  377. k=i '/' j ;
  378. mod=i '-' ( k '*'j ) ;
  379. 'RESPRO' mod ;
  380. 'FINSI' ;
  381. *
  382. * End of procedure file MODULO
  383. *
  384. 'FINPROC' ;
  385. *ENDPROCEDUR modulo
  386. * From . :
  387. *BEGINPROCEDUR calcoeil
  388. ************************************************************************
  389. * NOM : CALCOEIL
  390. * DESCRIPTION : Calcul un oeil absolu convenable pour les tracés
  391. * en donnant un oeil relatif et un maillage
  392. *
  393. *
  394. * LANGAGE : GIBIANE-CAST3M
  395. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  396. * mél : gounand@semt2.smts.cea.fr
  397. **********************************************************************
  398. * VERSION : v1, 16/11/2004, version initiale
  399. * HISTORIQUE : v1, 16/11/2004, création
  400. * HISTORIQUE :
  401. * HISTORIQUE :
  402. ************************************************************************
  403. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  404. * en cas de modification de ce sous-programme afin de faciliter
  405. * la maintenance !
  406. ************************************************************************
  407. *
  408. *
  409. 'DEBPROC' CALCOEIL ;
  410. 'ARGUMENT' mt*'MAILLAGE' ;
  411. 'ARGUMENT' foeil*'POINT' ;
  412. foeilx foeily foeilz = 'COORDONNEE' foeil ;
  413. xmt ymt zmt = 'COORDONNEE' mt ;
  414. maxmt = 'MAXIMUM' xmt ;
  415. maymt = 'MAXIMUM' ymt ;
  416. mazmt = 'MAXIMUM' zmt ;
  417. dx = '-' ('MAXIMUM' xmt) ('MINIMUM' xmt) ;
  418. dy = '-' ('MAXIMUM' ymt) ('MINIMUM' ymt) ;
  419. dxy = 'MAXIMUM' ('PROG' dx dy) ;
  420. dz = '-' ('MAXIMUM' zmt) ('MINIMUM' zmt) ;
  421. xoeil = '+' maxmt ('*' dxy foeilx) ;
  422. yoeil = '+' maymt ('*' dxy foeily) ;
  423. zoeil = '+' mazmt ('*' dz foeilz) ;
  424. oeil = xoeil yoeil zoeil ;
  425. 'RESPRO' oeil ;
  426. *
  427. * End of procedure file CALCOEIL
  428. *
  429. 'FINPROC' ;
  430. *ENDPROCEDUR calcoeil
  431. *BEGINPROCEDUR compute
  432. ************************************************************************
  433. * NOM : COMPUTE
  434. * DESCRIPTION : Do the computations of the stationnary fields
  435. * in the reactor
  436. *
  437. *
  438. * LANGAGE : GIBIANE-CAST3M
  439. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  440. * mél : gounand@semt2.smts.cea.fr
  441. **********************************************************************
  442. * VERSION : v1, 09/11/2004, version initiale
  443. * HISTORIQUE : v1, 09/11/2004, création
  444. * HISTORIQUE :
  445. * HISTORIQUE :
  446. ************************************************************************
  447. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  448. * en cas de modification de ce sous-programme afin de faciliter
  449. * la maintenance !
  450. ************************************************************************
  451. *
  452. *
  453. 'DEBPROC' COMPUTE ;
  454. *
  455. 'ARGUMENT' tabdat*'TABLE' ;
  456. *
  457. * First store all the parameters to make tabres self-contained
  458. *
  459. tabres = 'TABLE' 'INCO' ;
  460. tabres . 'tabdat' = tabdat ;
  461. *
  462. * Second, retrieve parameters from tables
  463. *
  464. tabgeo = tabdat . 'tabgeo' ;
  465. tabphy = tabdat . 'tabphy' ;
  466. tabnum = tabdat . 'tabnum' ;
  467. *
  468. H = tabgeo . 'H' ;
  469. nh = tabgeo . 'nh' ;
  470. $mtcbst = tabgeo . '$mtcbst' ;
  471. $mtcb = tabgeo . '$mtcb' ;
  472. $mthe = tabgeo . '$mthe' ;
  473. $sthe = tabgeo . '$sthe' ;
  474. $mtif = tabgeo . '$mtif' ;
  475. *'SI' logb ;
  476. * $mtifb = tabgeo . '$mtifb' ;
  477. *'FINSI' ;
  478. mcf = tabgeo . 'mcf' ;
  479. mfc = tabgeo . 'mfc' ;
  480. *
  481. Dh = tabphy . 'Dh' ;
  482. chblock= tabphy . 'chblock' ;
  483. *vhe = tabphy . 'vhe' ;
  484. qhe = tabphy . 'qhe' ;
  485. prhe = tabphy . 'prhe' ;
  486. theek = tabphy . 'theek' ;
  487. pvol = tabphy . 'pvol' ;
  488. pvar = tabphy . 'pvar' ;
  489. gamma = tabphy . 'gamma' ;
  490. irrad = tabphy . 'irrad' ;
  491. pcb = tabphy . 'pcb' ;
  492. *
  493. maxit = tabnum . 'maxit' ;
  494. rescvg = tabnum . 'rescvg' ;
  495. solvit = tabnum . 'solvit' ;
  496. omcbst = tabnum . 'omcbst' ;
  497. omhe = tabnum . 'omhe' ;
  498. *
  499. * Initialization of the tables for the thermal
  500. * computation in the fuel+structure (rvcbst)
  501. * and in the helium (rvhe)
  502. *
  503. rvcbst = 'EQEX' 'ITMA' 1 'NITER' 1 'OMEGA' omcbst 'FIDT' 1000 ;
  504. rvcbst = 'EQEX' rvcbst
  505. 'OPTI' 'EF' 'IMPL'
  506. 'ZONE' $mtcbst 'OPER' 'LAPN' 'LCBST' 'INCO' 'TCBS'
  507. ;
  508. rvcbst = 'EQEX' rvcbst
  509. 'OPTI' 'EF' 'IMPL'
  510. 'ZONE' $mtcb 'OPER' 'FIMP' 'PCB' 'INCO' 'TCBS'
  511. ;
  512. rvcbst = 'EQEX' rvcbst
  513. 'OPTI' 'EF' 'IMPL'
  514. 'ZONE' $mtif 'OPER' 'ECHI' 'H' 'T0' 'INCO' 'TCBS' 'TCBS'
  515. ;
  516. *
  517. * Iterative solver for the fuel+structure part
  518. *
  519. * 1 : direct solver, more robust, slower
  520. * 3 : iterative solver, less robust, faster
  521. 'SI' solvit ;
  522. rvcbst . 'METHINV' . 'TYPINV' = 3 ;
  523. 'SINON' ;
  524. rvcbst . 'METHINV' . 'TYPINV' = 1 ;
  525. 'FINSI' ;
  526. *
  527. rvhe = 'EQEX' 'ITMA' 1 'NITER' 1 'OMEGA' omhe 'FIDT' 1000 ;
  528. rvhe = 'EQEX' rvhe
  529. 'OPTI' 'EF' 'IMPL' 'CENTREE' 'NOCONS'
  530. 'ZONE' $mthe 'OPER' 'KONV' 'RCPHE' 'UHE' 'LHE' 'INCO' 'THE'
  531. ;
  532. rvhe = 'EQEX' rvhe
  533. 'OPTI' 'EF' 'IMPL'
  534. 'ZONE' $mthe 'OPER' 'LAPN' 'LHE' 'INCO' 'THE'
  535. ;
  536. rvhe = 'EQEX' rvhe
  537. 'OPTI' 'EF' 'IMPL'
  538. 'ZONE' $mthe 'OPER' 'FIMP' 'PHE' 'INCO' 'THE'
  539. ;
  540. rvhe = 'EQEX' rvhe
  541. 'CLIM' 'THE' 'TIMP' ('DOMA' $sthe 'MAILLAGE') theek ;
  542. rvcbst . 'INCO' = tabres ;
  543. rvhe . 'INCO' = tabres ;
  544. tabres . 'TCBS' = 'KCHT' $mtcbst 'SCAL' 'SOMMET' theek ;
  545. lupu lsic lcb okcb = PRPCB irrad theek ;
  546. tabres . 'LCBST' = 'KCHT' $mtcbst 'SCAL' 'CENTRE' lsic
  547. ('KCHT' $mtcb 'SCAL' 'CENTRE' lcb) ;
  548. tabres . 'PCB' = pcb ;
  549. tabres . 'T0' = 'KCHT' $mtif 'SCAL' 'CENTRE' 0.D0 ;
  550. tabres . 'F0' = 'KCHT' $mtif 'SCAL' 'CENTRE' 0.D0 ;
  551. tabres . 'H' = 'KCHT' $mtif 'SCAL' 'CENTRE' 0.D0 ;
  552. tabres . 'THE' = 'KCHT' $mthe 'SCAL' 'SOMMET' theek ;
  553. tabres . 'PHE' = 'KCHT' $mthe 'SCAL' 'CENTRE' 0.D0 ;
  554. thep = 'COPIER' (tabres . 'THE') ;
  555. tcbsp = 'COPIER' (tabres . 'TCBS') ;
  556. *
  557. * Initialization of the physical properties of helium
  558. *
  559. rhe muhe lhe cphe okhe = PRPHE prhe theek ;
  560. *qhe = '*' rhe vhe ;
  561. qheb = '*' qhe chblock ;
  562. qhebi = '*' mcf ('NOEL' $mthe qheb) ;
  563. * Ce KCHT est indispensable car '*' supprimme les valeurs nulles...
  564. qhebi = 'KCHT' $mtif 'SCAL' 'CENTRE' qhebi ;
  565. uhe = 'NOMC' 'UZ' ('/' qheb rhe) 'NATURE' 'DISCRET' ;
  566. tabres . 'RCPHE' = 'KCHT' $mthe 'SCAL' 'CENTRE' ('*' rhe cphe) ;
  567. tabres . 'LHE' = 'KCHT' $mthe 'SCAL' 'CENTRE' lhe ;
  568. *tabres . 'UHE' = 'KCHT' $mthe 'VECT' 'SOMMET' (0.D0 0.D0 uhe) ;
  569. *tabres . 'QHE' = qhe ;
  570. tabres . 'UHE' = 'KCHT' $mthe 'VECT' 'SOMMET' uhe ;
  571. tabres . 'QHE' = qheb ;
  572. ***************************************
  573. *
  574. * COMPUTATIONAL LOOP
  575. *
  576. ***************************************
  577. * Number of non-linearity iterations
  578. maxiter = vrai ;
  579. *
  580. 'REPETER' bouc maxit ;
  581. * 1) Compute a mean temperature in helium
  582. tmoyhe = 'NOEL' $mthe (tabres . 'THE') ;
  583. 'MESSAGE' 'Maximum mean helium temperature (degrees C) : '
  584. ('-' ('MAXIMUM' tmoyhe) 273.15D0) ;
  585. * 2) Transfer this temperature on the interfaces
  586. tmtif = '*' mcf tmoyhe ;
  587. * Ce KCHT est indispensable car '*' supprimme les valeurs nulles...
  588. tabres . 'T0' = 'KCHT' $mtif 'SCAL' 'CENTRE' tmtif ;
  589. * 3) Compute the exchange coefficient at the interface
  590. * and the physical properties of the fuel and the
  591. * structure with the temperature from the
  592. * previous iteration
  593. * Mixing temperature
  594. tm = tabres . 'T0' ;
  595. * Wall temperature
  596. tp = 'NOEL' $mtif (tabres . 'TCBS') ;
  597. t0 = '*' ('+' tm tp) 0.5D0 ;
  598. * t0 = tabres . 'T0' ;
  599. rho0 mu0 l0 cp0 okhe = PRPHE prhe t0 ;
  600. pran0 = '*' ('*' mu0 cp0) ('INVERSE' l0) ;
  601. * reyn0 = '*' ('*' qhe Dh) ('INVERSE' mu0) ;
  602. reyn0 = '*' ('*' qhebi Dh) ('INVERSE' mu0) ;
  603. * Colburn correlation
  604. nuss0 = 0.023 '*' ('**' reyn0 0.8D0)
  605. '*' ('**' pran0 ('/' 1.D0 3.D0)) ;
  606. h0 = '/' ('*' nuss0 l0) Dh ;
  607. * Tests
  608. * asp = '/' H Dh ;
  609. minasp = 60. ;
  610. minreyn = 1.D4 ;
  611. minpran = 0.65 ;
  612. maxpran = 160. ;
  613. asp = '/' H ('MAXIMUM' Dh) ;
  614. mireyn = 'MINIMUM' reyn0 ;
  615. mareyn = 'MAXIMUM' reyn0 ;
  616. okreyn = '>' mireyn minreyn ;
  617. mipran = 'MINIMUM' pran0 ;
  618. mapran = 'MAXIMUM' pran0 ;
  619. * okpr = 'ET' ('>' mipran 0.7) ('<' mapran 160.) ;
  620. okipr = '>' mipran minpran ;
  621. okapr = '<' mapran maxpran ;
  622. okpr = 'ET' okipr okapr ;
  623. okasp = '>' asp minasp ;
  624. oknuss = okreyn 'ET' okpr 'ET' okasp ;
  625. 'SI' ('NON' oknuss) ;
  626. cherr = 'CHAINE' '!! Correlation de Colburn non valide' ;
  627. 'MESSAGE' cherr ;
  628. 'SI' ('NON' okreyn) ;
  629. cherr = 'CHAINE' ' min Re=' (formar mireyn 2)
  630. ' (should be ' (formar minreyn 2) ')' ;
  631. 'MESSAGE' cherr ;
  632. cherr = 'CHAINE' ' (Note : max Re=' (formar mareyn 2) ')' ;
  633. 'MESSAGE' cherr ;
  634. 'FINSI' ;
  635. 'SI' ('NON' okipr) ;
  636. cherr = 'CHAINE' ' min Pr=' (formar mipran 2)
  637. ' (should be ' (formar minpran 2) ')' ;
  638. 'MESSAGE' cherr ;
  639. 'FINSI' ;
  640. 'SI' ('NON' okapr) ;
  641. cherr = 'CHAINE' ' max Pr=' (formar mapran 2)
  642. ' (should be ' (formar maxpran 2) ')' ;
  643. 'MESSAGE' cherr ;
  644. 'FINSI' ;
  645. 'SI' ('NON' okasp) ;
  646. cherr = 'CHAINE' ' min H/Dh=' (formar asp 2)
  647. ' (should be ' (formar minasp 2) ')' ;
  648. 'MESSAGE' cherr ;
  649. 'FINSI' ;
  650. 'FINSI' ;
  651. * tabres . 'H' = 'KCHT' $mtif 'SCAL' 'CENTRE' ('*' h0 chblock) ;
  652. tabres . 'H' = 'KCHT' $mtif 'SCAL' 'CENTRE' h0 ;
  653. tabres . 'nuss0' = 'KCHT' $mtif 'SCAL' 'CENTRE' nuss0 ;
  654. tabres . 'reyn0' = 'KCHT' $mtif 'SCAL' 'CENTRE' reyn0 ;
  655. tabres . 'pran0' = 'KCHT' $mtif 'SCAL' 'CENTRE' pran0 ;
  656. tabres . 'l0' = 'KCHT' $mtif 'SCAL' 'CENTRE' l0 ;
  657. tabres . 'Dh' = 'KCHT' $mtif 'SCAL' 'CENTRE' Dh ;
  658. * Physical properties of fuel and structure
  659. tcbck = 'NOEL' $mtcbst (tabres . 'TCBS') ;
  660. lupu lsic lcb okcb = PRPCB irrad tcbck ;
  661. tabres . 'LCBST' = 'KCHT' $mtcbst 'SCAL' 'CENTRE' lsic
  662. ('KCHT' $mtcb 'SCAL' 'CENTRE' lcb) ;
  663. * 4) Thermal computation in fuel + structure
  664. EXEC rvcbst ;
  665. * 5) Flux computation on the surface of the fuel
  666. rvmdia1 = 'EQEX' 'OPTI' 'VF' 'IMPL'
  667. 'ZONE' $mtif 'OPER' 'MDIA' 'H' 'INCO' 'TCBS' 'F0' ;
  668. rvmdia1 . 'INCO' = tabres ;
  669. smdia1 mmdia1 = 'MDIA' (rvmdia1 . '1MDIA') ;
  670. rvmdia2 = 'EQEX' 'OPTI' 'VF' 'IMPL'
  671. 'ZONE' $mtif 'OPER' 'MDIA' 'H' 'INCO' 'T0' 'F0' ;
  672. rvmdia2 . 'INCO' = tabres ;
  673. smdia2 mmdia2 = 'MDIA' (rvmdia2 . '1MDIA') ;
  674. f0 = 'NOMC' 'SCAL' ('-' ('KOPS' mmdia1 '*'
  675. ('NOMC' 'TCBS' (tabres . 'TCBS')))
  676. ('KOPS' mmdia2 '*'
  677. ('NOMC' 'T0' (tabres . 'T0'))))
  678. ;
  679. 'MESSAGE' 'Integrated flux on the surface of the fuel (W) : '
  680. ('MAXIMUM' ('RESULT' f0)) ;
  681. * 6) Transfer it to a volume power in the helium
  682. tabres . 'F0' = f0 ;
  683. phe = '*' mfc f0 ;
  684. tabres . 'PHE' = 'KCHT' $mthe 'SCAL' 'CENTRE' phe ;
  685. *
  686. * 7) Compute the physical properties of helium with temperature and
  687. * pressure from the previous iteration
  688. *
  689. theck = 'NOEL' $mthe (tabres . 'THE') ;
  690. thesk = tabres . 'THE' ;
  691. rhec muhec lhec cphec okhe = PRPHE prhe theck ;
  692. rhes muhes lhes cphes okhe = PRPHE prhe thesk ;
  693. * uhes = 'NOMC' 'UZ' ('*' qhe ('INVERSE' rhes)) ;
  694. uhes = 'NOMC' 'UZ' ('*' qheb ('INVERSE' rhes)) ;
  695. tabres . 'RCPHE' = 'KCHT' $mthe 'SCAL' 'CENTRE' ('*' rhec cphec) ;
  696. tabres . 'LHE' = 'KCHT' $mthe 'SCAL' 'CENTRE' lhec ;
  697. tabres . 'UHE' = 'KCHT' $mthe 'VECT' 'SOMMET' uhes ;
  698. * 8) Thermal computation in the helium
  699. EXEC rvhe ;
  700. *
  701. * Convergence check
  702. *
  703. then = 'COPIER' (tabres . 'THE') ;
  704. tcbsn = 'COPIER' (tabres . 'TCBS') ;
  705. errhe = '/' ('MAXIMUM' ('-' then thep) 'ABS')
  706. ('MAXIMUM' thep 'ABS') ;
  707. errcbs = '/' ('MAXIMUM' ('-' tcbsn tcbsp) 'ABS')
  708. ('MAXIMUM' tcbsp 'ABS') ;
  709. 'MESSAGE' ('CHAINE' 'Iteration ' &bouc) ;
  710. 'MESSAGE' ('CHAINE' ' errhe = ' errhe) ;
  711. 'MESSAGE' ('CHAINE' ' errcbs = ' errcbs) ;
  712. thep = then ;
  713. tcbsp = tcbsn ;
  714. testcvg = 'ET' (errhe '<' rescvg) (errcbs '<' rescvg) ;
  715. *
  716. * Plots
  717. *
  718. * explores tabres ;
  719. 'SI' testcvg ;
  720. maxiter = faux ;
  721. 'QUITTER' bouc ;
  722. 'FINSI' ;
  723. 'FIN' bouc ;
  724. 'SI' ('EGA' maxiter vrai) ;
  725. 'MESSAGE' ('CHAINE' 'Warning !!!!!!!!!!!!') ;
  726. 'MESSAGE' ('CHAINE' 'Warning !!!!!!!!!!!!') ;
  727. 'MESSAGE' ('CHAINE' 'Warning !!!!!!!!!!!!') ;
  728. 'MESSAGE' ('CHAINE' 'Warning !!!!!!!!!!!!') ;
  729. 'MESSAGE' ('CHAINE' 'Warning !!!!!!!!!!!!') ;
  730. 'MESSAGE' ('CHAINE' 'Warning !!!!!!!!!!!!') ;
  731. 'MESSAGE' ('CHAINE' 'Warning !!!!!!!!!!!!') ;
  732. 'MESSAGE' ('CHAINE' 'Warning !!!!!!!!!!!!') ;
  733. 'MESSAGE' ('CHAINE' 'Warning !!!!!!!!!!!!') ;
  734. 'MESSAGE' ('CHAINE' 'The computation has not converged') ;
  735. 'ERREUR' 'Check compute.procedur !' ;
  736. 'FINSI' ;
  737. 'RESPRO' tabres ;
  738. *
  739. * End of procedure file COMPUTE
  740. *
  741. 'FINPROC' ;
  742. *ENDPROCEDUR compute
  743. *BEGINPROCEDUR cpowdis
  744. ************************************************************************
  745. * NOM : CPOWDIS
  746. * DESCRIPTION : Compute cos (z) power distribution
  747. *
  748. *
  749. *
  750. * LANGAGE : GIBIANE-CAST3M
  751. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  752. * mél : gounand@semt2.smts.cea.fr
  753. **********************************************************************
  754. * VERSION : v1, 09/11/2004, version initiale
  755. * HISTORIQUE : v1, 09/11/2004, création
  756. * HISTORIQUE :
  757. * HISTORIQUE :
  758. ************************************************************************
  759. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  760. * en cas de modification de ce sous-programme afin de faciliter
  761. * la maintenance !
  762. ************************************************************************
  763. *
  764. *
  765. 'DEBPROC' CPOWDIS ;
  766. 'ARGUMENT' tabgeo*'TABLE' ;
  767. 'ARGUMENT' pvol*'FLOTTANT' ;
  768. 'ARGUMENT' gamma*'FLOTTANT' ;
  769. 'ARGUMENT' pvar*'LOGIQUE' ;
  770. *
  771. $mtcbst = tabgeo . '$mtcbst' ;
  772. $mtcb = tabgeo . '$mtcb' ;
  773. $mthe = tabgeo . '$mthe' ;
  774. *
  775. vcbst = 'MAXIMUM' ('RESULT' ('DOMA' $mtcbst 'VOLUME')) ;
  776. vcb = 'MAXIMUM' ('RESULT' ('DOMA' $mtcb 'VOLUME')) ;
  777. vhe = 'MAXIMUM' ('RESULT' ('DOMA' $mthe 'VOLUME')) ;
  778. vcoeur = '+' vcbst vhe ;
  779. *
  780. pmoy = pvol '*' ('/' vcoeur vcb) ;
  781. 'SI' ('NON' pvar) ;
  782. pcb = 'KCHT' $mtcb 'SCAL' 'CENTRE' pmoy ;
  783. 'SINON' ;
  784. raddeg = '/' 180.D0 PI ;
  785. zcb = 'COORDONNEE' 3 ('DOMA' $mtcb 'CENTRE') ;
  786. zmoy = '/' H 2.D0 ;
  787. zcb = '+' zcb ('*' zmoy -1.D0) ;
  788. pmax = '*' pmoy ('/' gamma ('SIN' ('*' raddeg gamma))) ;
  789. 'MESSAGE' ('CHAINE' 'gamma=' gamma) ;
  790. 'MESSAGE' ('CHAINE' 'pmax=' pmax) ;
  791. fccos = '/' (2.D0 '*' gamma '*' raddeg) H ;
  792. pcb1 = '*' ('COS' ('*' zcb fccos)) pmax ;
  793. chvol = 'DOMA' $mtcb 'VOLUME' ;
  794. puis1 = 'MAXIMUM' ('RESULT' ('*' chvol pmoy)) ;
  795. puis2 = 'MAXIMUM' ('RESULT' ('*' chvol pcb1)) ;
  796. 'SI' ('NON' ('EGA' puis1 puis2 ('*' 0.1 ('ABS' puis2)))) ;
  797. 'MESSAGE' ('CHAINE' 'puis1 = ' puis1 ) ;
  798. 'MESSAGE' ('CHAINE' 'puis2 = ' puis2 ) ;
  799. 'ERREUR' 'Les deux puissances devraient etre a peu pres egales' ;
  800. 'FINSI' ;
  801. * Correction
  802. facor = '/' puis1 puis2 ;
  803. pcb2 = '*' pcb1 facor ;
  804. pcb = 'KCHT' $mtcb 'SCAL' 'CENTRE' pcb2 ;
  805. 'FINSI' ;
  806. 'RESPRO' pcb ;
  807. *
  808. * End of procedure file CPOWDIS
  809. *
  810. 'FINPROC' ;
  811. *ENDPROCEDUR cpowdis
  812. *BEGINPROCEDUR dessevol
  813. ************************************************************************
  814. * NOM : DESSEVOL
  815. * DESCRIPTION : Dessine des évolutions : choisit automatiquement
  816. * les options, marqueurs, couleurs...
  817. *
  818. *
  819. * LANGAGE : GIBIANE-CAST3M
  820. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  821. * mél : gounand@semt2.smts.cea.fr
  822. **********************************************************************
  823. * VERSION : v1, 16/11/2004, version initiale
  824. * HISTORIQUE : v1, 16/11/2004, création
  825. * HISTORIQUE :
  826. * HISTORIQUE :
  827. ************************************************************************
  828. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  829. * en cas de modification de ce sous-programme afin de faciliter
  830. * la maintenance !
  831. ************************************************************************
  832. *
  833. *
  834. 'DEBPROC' DESSEVOL ;
  835. 'ARGUMENT' evtot*'EVOLUTION' ;
  836. 'ARGUMENT' tabt*'TABLE' ;
  837. 'ARGUMENT' tit*'MOT' ;
  838. 'ARGUMENT' tix*'MOT' ;
  839. 'ARGUMENT' tiy*'MOT' ;
  840. 'ARGUMENT' lnclk*'LOGIQUE' ;
  841. 'ARGUMENT' nb/'LOGIQUE' ;
  842. *
  843. 'SI' ('NON' ('EXISTE' nb)) ;
  844. nb = FAUX ;
  845. 'FINSI' ;
  846. *
  847. nt = 'DIME' tabt ;
  848. nev = 'DIME' evtot ;
  849. *
  850. * Attention, dans evtot, il y a une évolution avec des noms de points ?
  851. *
  852. *'SI' ('NEG' nev nt) ;
  853. * cherr = 'CHAINE' 'Evolution and title table : not same dim.' ;
  854. * 'ERREUR' cherr ;
  855. *'FINSI' ;
  856. *
  857. tev = 'TABLE' ;
  858. tev . 'TITRE' = tabt ;
  859. *
  860. toto = 'TABLE' ;
  861. *
  862. lcoul = 'MOTS' 'TURQ' 'VERT' 'JAUN' 'ROSE' 'ROUG' 'BLEU' ;
  863. lmarq = 'MOTS' 'TRIB' 'TRIA' 'LOSA' 'CARR' 'ETOI' 'PLUS' 'CROI' ;
  864. ltirr = 'MOTS' 'TIRR' 'TIRC' 'TIRL' 'TIRM' ;
  865. *
  866. 'SI' nb ;
  867. ev2 = evtot ;
  868. 'SINON' ;
  869. icou = 0 ;
  870. 'REPETER' iev nev ;
  871. ii = &iev ;
  872. evi = 'EXTRAIRE' evtot 'COUR' ii ;
  873. 'SI' ('NEG' ('TYPE' ('EXTRAIRE' evi 'ORDO')) 'LISTMOTS') ;
  874. icou = '+' icou 1 ;
  875. 'FINSI' ;
  876. * ii2 = '/' ('+' ii 1) 2 ;
  877. * ci = EXMOMOD lcoul ii2 ;
  878. * ci = EXMOMOD lcoul ii ;
  879. ci = EXMOMOD lcoul icou ;
  880. APPEND toto 'EVOLUTION' ('COULEUR' evi ci) ;
  881. 'FIN' iev ;
  882. ev2 = toto . 'EVOLUTION' ;
  883. 'FINSI' ;
  884. *
  885. 'REPETER' iev nev ;
  886. ii = &iev ;
  887. mi = EXMOMOD lmarq ii ;
  888. ti = EXMOMOD ltirr ii ;
  889. 'SI' nb ;
  890. tev . ii = 'CHAINE' 'MARQ ' mi ' ' ti ;
  891. 'SINON' ;
  892. tev . ii = 'CHAINE' 'MARQ ' mi ;
  893. 'FINSI' ;
  894. 'FIN' iev ;
  895. *
  896. 'SI' lnclk ;
  897. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
  898. 'NCLK' ;
  899. 'SINON' ;
  900. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev ;
  901. 'FINSI' ;
  902. *
  903. * End of procedure file DESSEVOL
  904. *
  905. 'FINPROC' ;
  906. *ENDPROCEDUR dessevol
  907. *BEGINPROCEDUR explodat
  908. ************************************************************************
  909. * NOM : EXPLODAT
  910. * DESCRIPTION : Explore the data interactively or not.
  911. *
  912. * - first argument (mandatory) : the tables with data
  913. * - second argument (optional) : VRAI (default) interactive use
  914. * (mouse clicks)
  915. * FAUX batch use
  916. * - third argument (mandatory if 2ndarg = FAUX) : a list of integer or
  917. * an integer
  918. * an integer corresponds to a particular view
  919. * View 1 : the base mesh
  920. * View 2 : the mesh
  921. * View 3 : the blocked channels
  922. * View 4 : the power distribution
  923. * View 5 : fuel and structure thermal conductivity (T)
  924. * View 6 : Helium density
  925. * View 7 : Helium thermal conductivity
  926. * View 8 : Helium heat capacity
  927. *
  928. *
  929. * LANGAGE : GIBIANE-CAST3M
  930. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  931. * mél : gounand@semt2.smts.cea.fr
  932. **********************************************************************
  933. * VERSION : v1, 17/11/2004, version initiale
  934. * HISTORIQUE : v1, 17/11/2004, création
  935. * HISTORIQUE :
  936. * HISTORIQUE :
  937. ************************************************************************
  938. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  939. * en cas de modification de ce sous-programme afin de faciliter
  940. * la maintenance !
  941. ************************************************************************
  942. *
  943. *
  944. 'DEBPROC' EXPLODAT ;
  945. 'ARGUMENT' tabdat*'TABLE';
  946. 'ARGUMENT' interact/'LOGIQUE' ;
  947. 'SI' ('NON' ('EXISTE' interact)) ;
  948. interact = VRAI ;
  949. 'FINSI' ;
  950. *
  951. 'SI' ('NON' interact) ;
  952. 'ARGUMENT' liview/'LISTENTI' ;
  953. 'SI' ('NON' ('EXISTE' liview)) ;
  954. 'ARGUMENT' iview*'ENTIER' ;
  955. liview = 'LECT' iview ;
  956. 'FINSI' ;
  957. niview = 'DIME' liview ;
  958. 'SI' ('<' niview 1) ;
  959. 'QUITTER' EXPLODAT ;
  960. 'FINSI' ;
  961. iiview = 1 ;
  962. 'FINSI' ;
  963. *
  964. * Retrieve parameters from tables
  965. *
  966. tabgeo = tabdat . 'tabgeo' ;
  967. tabphy = tabdat . 'tabphy' ;
  968. tabin = tabgeo . 'tabin' ;
  969. logst = 'EXISTE' tabin 'STRUCTURE' ;
  970. *
  971. H = tabgeo . 'H' ;
  972. nh = tabgeo . 'nh' ;
  973. $mtcbst = tabgeo . '$mtcbst' ;
  974. $mtcb = tabgeo . '$mtcb' ;
  975. $mthe = tabgeo . '$mthe' ;
  976. $sthe = tabgeo . '$sthe' ;
  977. $mtif = tabgeo . '$mtif' ;
  978. cfc = tabgeo . 'cfc' ;
  979. amtcb = tabgeo . 'amtcb' ;
  980. amthe = tabgeo . 'amthe' ;
  981. * QUAF meshes
  982. _mtcbst = 'DOMA' $mtcbst 'QUAF' ;
  983. _mthe = 'DOMA' $mthe 'QUAF' ;
  984. mtcbst = 'DOMA' $mtcbst 'MAILLAGE' ;
  985. mtcb = 'DOMA' $mtcb 'MAILLAGE' ;
  986. mthe = 'DOMA' $mthe 'MAILLAGE' ;
  987. 'SI' logst ;
  988. mtst = 'DIFF' mtcbst mtcb ;
  989. 'FINSI' ;
  990. mthe = 'DOMA' $mthe 'MAILLAGE' ;
  991. mtif = 'DOMA' $mtif 'MAILLAGE' ;
  992. *
  993. Dh = tabphy . 'Dh' ;
  994. chblock= tabphy . 'chblock' ;
  995. *vhe = tabphy . 'vhe' ;
  996. qhe = tabphy . 'qhe' ;
  997. prhe = tabphy . 'prhe' ;
  998. theek = tabphy . 'theek' ;
  999. pvol = tabphy . 'pvol' ;
  1000. pvar = tabphy . 'pvar' ;
  1001. gamma = tabphy . 'gamma' ;
  1002. irrad = tabphy . 'irrad' ;
  1003. pcb = tabphy . 'pcb' ;
  1004. * compute bottom He speed
  1005. rhohe muhe lhe cphe dum = PRPHE prhe theek ;
  1006. vhe = '/' qhe rhohe ;
  1007. *
  1008. * Precomputations
  1009. *
  1010. * One wants the height (z) not to be more than four times x or y dimension
  1011. * targetz = 4.D0 ;
  1012. targetz = 1.5D0 ;
  1013. * targetz = 0.5D0 ;
  1014. ftour = 0.1D0 ;
  1015. _mtot = 'ET' _mtcbst _mthe ;
  1016. xmt ymt zmt = 'COORDONNEE' _mtot ;
  1017. dx = '-' ('MAXIMUM' xmt) ('MINIMUM' xmt) ;
  1018. dy = '-' ('MAXIMUM' ymt) ('MINIMUM' ymt) ;
  1019. dxy = 'MAXIMUM' ('PROG' dx dy) ;
  1020. dz = '-' ('MAXIMUM' zmt) ('MINIMUM' zmt) ;
  1021. dzdx = '/' dz dx ;
  1022. chzscale = '>' dzdx targetz ;
  1023. 'SI' chzscale ;
  1024. zfactor = '/' dzdx targetz ;
  1025. factech = ('-' ('/' 1.D0 zfactor) 1.D0) ;
  1026. dzmt = 'NOMC' 'UZ' ('*' zmt factech) 'NATURE' 'DISCRET' ;
  1027. orig = 'FORME' ;
  1028. defrm = 'FORME' dzmt ;
  1029. 'FINSI' ;
  1030. *
  1031. 'SI' interact ;
  1032. mail = ('COULEUR' mtcb 'ROUG')
  1033. 'ET' ('COULEUR' mthe 'BLEU') ;
  1034. 'SI' (logst) ;
  1035. mail = 'ET' mail ('COULEUR' mtst 'BLANC') ;
  1036. 'FINSI' ;
  1037. npomail = 'NBNO' mail ;
  1038. nelmail = 'NBEL' mail ;
  1039. titmail = 'CHAINE' 'Mesh ' 'NBPO=' npomail
  1040. ' NBELEM=' nelmail ;
  1041. TRACMESH mail titmail VRAI ;
  1042. 'FINSI' ;
  1043. *
  1044. * Precomp of physical properties
  1045. *
  1046. * Temperature evolutions (in °C !!!)
  1047. Tmin = 500.D0 ;
  1048. Tmax = 1600.D0 ;
  1049. npasT = 10.D0 ;
  1050. pasT = '/' ('-' Tmax Tmin) npasT ;
  1051. prT = 'PROG' Tmin 'PAS' pasT Tmax ;
  1052. prlupu = 'PROG' ;
  1053. prlsic = 'PROG' ;
  1054. prlcb = 'PROG' ;
  1055. nbc = 'DIME' prT ;
  1056. 'REPETER' ibc nbc ;
  1057. T = 'EXTRAIRE' pRT &ibc ;
  1058. T = '+' T 273.15D0 ;
  1059. lupu lsic lcb dum = PRPCB FAUX T ;
  1060. prlupu = 'ET' prlupu ('PROG' lupu) ;
  1061. prlsic = 'ET' prlsic ('PROG' lsic) ;
  1062. prlcb = 'ET' prlcb ('PROG' lcb) ;
  1063. 'FIN' ibc ;
  1064. evlupu = 'EVOL' 'MANU' 'T' prT 'Lambda' prlupu ;
  1065. evlsic = 'EVOL' 'MANU' 'T' prT 'Lambda' prlsic ;
  1066. evlcb = 'EVOL' 'MANU' 'T' prT 'Lambda' prlcb ;
  1067. * Helium prop
  1068. * Temperature evolutions (in °C !!!)
  1069. Tmin = 450.D0 ;
  1070. Tmax = 1150.D0 ;
  1071. npasT = 10.D0 ;
  1072. pasT = '/' ('-' Tmax Tmin) npasT ;
  1073. prT = 'PROG' Tmin 'PAS' pasT Tmax ;
  1074. prrho = 'PROG' ;
  1075. prlamb = 'PROG' ;
  1076. prcp = 'PROG' ;
  1077. nbc = 'DIME' prT ;
  1078. 'REPETER' ibc nbc ;
  1079. T = 'EXTRAIRE' pRT &ibc ;
  1080. T = '+' T 273.15D0 ;
  1081. rho mu lamb cp dum = PRPHE prhe T ;
  1082. prrho = 'ET' prrho ('PROG' rho) ;
  1083. prlamb = 'ET' prlamb ('PROG' lamb) ;
  1084. prcp = 'ET' prcp ('PROG' cp) ;
  1085. 'FIN' ibc ;
  1086. evrho = 'EVOL' 'MANU' 'T' prT 'Rho' prrho ;
  1087. evlamb = 'EVOL' 'MANU' 'T' prT 'Lambda' prlamb ;
  1088. evcp = 'EVOL' 'MANU' 'T' prT 'Cp' prcp ;
  1089. *
  1090. * Arete precomp
  1091. *
  1092. *amtcb = 'ARETE' mtcb ;
  1093. *
  1094. tcha = 'TABLE' ;
  1095. tcha . 1 = 'BMesh' ;
  1096. tcha . 2 = 'Mesh' ;
  1097. tcha . 3 = 'BChan' ;
  1098. tcha . 4 = 'FuelT2' ;
  1099. tcha . 5 = 'LFuel' ;
  1100. tcha . 6 = 'RhoHe' ;
  1101. tcha . 7 = 'LamHe' ;
  1102. tcha . 8 = 'CpHe' ;
  1103. ntcha = 'DIME' tcha ;
  1104. 'SI' interact ;
  1105. itcha = 1 ;
  1106. noclic = VRAI ;
  1107. 'SINON' ;
  1108. itcha = 'EXTRAIRE' liview iiview ;
  1109. noclic = FAUX ;
  1110. 'FINSI' ;
  1111. *
  1112. 'REPETER' bouc2 ;
  1113. 'SI' interact ;
  1114. 'MESSAGE' 'Noclic allows not to click between each view' ;
  1115. 'MESSAGE'
  1116. 'However, one will deactivate it in order to zoom or save' ;
  1117. noclic = 'CHOI' 'Choose desired options' noclic ;
  1118. 'FINSI' ;
  1119. *
  1120. 'REPETER' bouc1;
  1121. *
  1122. 'SI' ('EGA' itcha 1) ;
  1123. bmesh = ('COULEUR' (tabin . 'FUEL') 'ROUG') 'ET'
  1124. ('COULEUR' (@STBL (tabin . 'CHANNEL')) 'BLEU') ;
  1125. 'SI' logst ;
  1126. bmesh = 'ET' bmesh (tabin . 'STRUCTURE') ;
  1127. 'FINSI' ;
  1128. oeil = (0. 0. 1000.) ;
  1129. npomail = 'NBNO' bmesh ;
  1130. nelmail = 'NBEL' bmesh ;
  1131. tit = 'CHAINE' 'Base Mesh ' 'NBPO=' npomail
  1132. ' NBELEM=' nelmail ;
  1133. 'SI' noclic ;
  1134. TRAC oeil bmesh 'TITRE' tit 'NCLK' ;
  1135. 'SINON' ;
  1136. TRAC oeil bmesh 'TITRE' tit ;
  1137. 'FINSI' ;
  1138. 'FINSI' ;
  1139. 'SI' ('EGA' itcha 2) ;
  1140. mail = ('COULEUR' mtcb 'ROUG')
  1141. 'ET' ('COULEUR' mthe 'BLEU') ;
  1142. 'SI' (logst) ;
  1143. mail = 'ET' mail ('COULEUR' mtst 'BLANC') ;
  1144. 'FINSI' ;
  1145. npomail = 'NBNO' mail ;
  1146. nelmail = 'NBEL' mail ;
  1147. tit = 'CHAINE' 'Mesh ' 'NBPO=' npomail
  1148. ' NBELEM=' nelmail ;
  1149. TRACMESH mail tit noclic ;
  1150. 'FINSI' ;
  1151. 'SI' ('EGA' itcha 3) ;
  1152. * tit = 'CHAINE' 'Blocked channels' ;
  1153. * tracchml $mtif chblock tit noclic ;
  1154. tit = 'CHAINE' 'Blocked channels' ;
  1155. tracchpo chblock mthe amthe tit noclic ;
  1156. 'FINSI' ;
  1157. 'SI' ('EGA' itcha 4) ;
  1158. tit = 'CHAINE' 'Power Distribution (W.m-3)' ;
  1159. tracchml $mtcb pcb amtcb tit noclic ;
  1160. 'FINSI' ;
  1161. 'SI' ('EGA' itcha 5) ;
  1162. evt = evlupu 'ET' evlsic 'ET' evlcb ;
  1163. tt = 'TABLE' ;
  1164. 'SI' irrad ;
  1165. tt . 1 = 'CHAINE' '(U,Pu)C irr.' ;
  1166. tt . 2 = 'CHAINE' 'SiC irr.' ;
  1167. tt . 3 = 'CHAINE' 'CerCer irr.' ;
  1168. 'SINON' ;
  1169. tt . 1 = 'CHAINE' '(U,Pu)C' ;
  1170. tt . 2 = 'CHAINE' 'SiC' ;
  1171. tt . 3 = 'CHAINE' 'CerCer' ;
  1172. 'FINSI' ;
  1173. tit = 'CHAINE' 'Lambda(Temperature)' ;
  1174. titx = 'CHAINE' 'T (°C)' ;
  1175. tity = 'CHAINE' 'Lambda (W.m-1.K-1)' ;
  1176. DESSEVOL evt tt tit titx tity noclic ;
  1177. 'FINSI' ;
  1178. 'SI' ('EGA' itcha 6) ;
  1179. tt = 'TABLE' ;
  1180. tt . 1 = 'CHAINE' 'Helium' ;
  1181. tit = 'CHAINE' 'Density(Temperature)'
  1182. ' pres= ' (formar prhe 2) ' bar' ;
  1183. titx = 'CHAINE' 'T (°C)' ;
  1184. tity = 'CHAINE' 'Rho (kg.m-3)' ;
  1185. DESSEVOL evrho tt tit titx tity noclic ;
  1186. 'FINSI' ;
  1187. 'SI' ('EGA' itcha 7) ;
  1188. tt = 'TABLE' ;
  1189. tt . 1 = 'CHAINE' 'Helium' ;
  1190. tit = 'CHAINE' 'Thermal Conductivity (Temperature)'
  1191. ' pres= ' (formar prhe 2) ' bar' ;
  1192. titx = 'CHAINE' 'T (°C)' ;
  1193. tity = 'CHAINE' 'Lambda (W.m-1.K-1)' ;
  1194. DESSEVOL evlamb tt tit titx tity noclic ;
  1195. 'FINSI' ;
  1196. *
  1197. 'SI' ('EGA' itcha 8) ;
  1198. tt = 'TABLE' ;
  1199. tt . 1 = 'CHAINE' 'Helium' ;
  1200. tit = 'CHAINE' 'Specific Heat (Temperature)'
  1201. ' pres= ' (formar prhe 2) ' bar' ;
  1202. titx = 'CHAINE' 'T (°C)' ;
  1203. tity = 'CHAINE' 'Cp (J.kg-1.K-1)' ;
  1204. DESSEVOL evcp tt tit titx tity noclic ;
  1205. 'FINSI' ;
  1206. *
  1207. 'SI' interact ;
  1208. cha = tit ;
  1209. ret = 'MENU' cha 'Next' 'Previous' 'Options' ;
  1210. 'SI' ('EGA' ret 'Options') ; 'QUITTER' bouc1 ; 'FINSI';
  1211. 'SI' ('EGA' ret 'Quitter') ; 'QUITTER' bouc2; 'FINSI';
  1212. 'SI' ('EGA' ret 'Next') ; itcha = '+' itcha 1 ; 'FINSI' ;
  1213. 'SI' ('EGA' ret 'Previous') ; itcha = '-' itcha 1 ; 'FINSI' ;
  1214. 'SI' (itcha > ntcha); itcha = 1 ; 'FINSI';
  1215. 'SI' (itcha < 1); itcha = ntcha ; 'FINSI';
  1216. 'SINON' ;
  1217. iiview = '+' iiview 1 ;
  1218. 'SI' ('>' iiview niview) ;
  1219. 'QUITTER' bouc2 ;
  1220. 'SINON' ;
  1221. itcha = 'EXTRAIRE' liview iiview ;
  1222. 'FINSI' ;
  1223. 'FINSI' ;
  1224. *
  1225. 'FIN' bouc1;
  1226. 'FIN' bouc2 ;
  1227. *
  1228. 'SI' chzscale ;
  1229. 'FORME' orig ;
  1230. 'FINSI' ;
  1231. *
  1232. * End of procedure file EXPLODAT
  1233. *
  1234. 'FINPROC' ;
  1235. *ENDPROCEDUR explodat
  1236. *BEGINPROCEDUR explores
  1237. ************************************************************************
  1238. * NOM : EXPLORES
  1239. * DESCRIPTION : Explore the Results interactively or not.
  1240. *
  1241. * EXPLORES does graphical output of results
  1242. * - first argument (mandatory) : the table with the fields
  1243. * - second argument (optional) : VRAI (default) interactive use
  1244. * (mouse clicks)
  1245. * FAUX batch use
  1246. * - third argument (mandatory if 2ndarg = FAUX) : a list of integer or
  1247. * an integer
  1248. * an integer corresponds to a particular view
  1249. * View 1 : temperature (fuel + He)
  1250. * View 2 : temperature (fuel)
  1251. * View 3 : temperature (fuel : 2 viewpoints)
  1252. * View 4 : exchange coefficient
  1253. * View 5 : temperature (helium)
  1254. * View 6 : vertical speed (helium)
  1255. * View 7 : temperature profiles per channel (helium)
  1256. * View 8 : vertical speed profiles per channel (helium)
  1257. * View 9 : Nusselt number
  1258. * View 10 : Reynolds number
  1259. * View 11 : Prandtl number
  1260. * View 12 : Lambda Helium
  1261. * View 13 : Hydraulic diameter
  1262. *
  1263. *
  1264. * LANGAGE : GIBIANE-CAST3M
  1265. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1266. * mél : gounand@semt2.smts.cea.fr
  1267. **********************************************************************
  1268. * VERSION : v1, 17/11/2004, version initiale
  1269. * HISTORIQUE : v1, 17/11/2004, création
  1270. * HISTORIQUE :
  1271. * HISTORIQUE :
  1272. ************************************************************************
  1273. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1274. * en cas de modification de ce sous-programme afin de faciliter
  1275. * la maintenance !
  1276. ************************************************************************
  1277. *
  1278. *
  1279. 'DEBPROC' EXPLORES ;
  1280. 'ARGUMENT' tabres*'TABLE' ;
  1281. 'ARGUMENT' interact/'LOGIQUE' ;
  1282. 'SI' ('NON' ('EXISTE' interact)) ;
  1283. interact = VRAI ;
  1284. 'FINSI' ;
  1285. *
  1286. 'SI' ('NON' interact) ;
  1287. 'ARGUMENT' liview/'LISTENTI' ;
  1288. 'SI' ('NON' ('EXISTE' liview)) ;
  1289. 'ARGUMENT' iview*'ENTIER' ;
  1290. liview = 'LECT' iview ;
  1291. 'FINSI' ;
  1292. niview = 'DIME' liview ;
  1293. 'SI' ('<' niview 1) ;
  1294. 'QUITTER' EXPLORES ;
  1295. 'FINSI' ;
  1296. iiview = 1 ;
  1297. 'FINSI' ;
  1298. *
  1299. * Retrieve parameters from tables
  1300. *
  1301. tabdat = tabres . 'tabdat' ;
  1302. tabgeo = tabdat . 'tabgeo' ;
  1303. tabin = tabgeo . 'tabin' ;
  1304. logst = 'EXISTE' tabin 'STRUCTURE' ;
  1305. *
  1306. H = tabgeo . 'H' ;
  1307. nh = tabgeo . 'nh' ;
  1308. $mtcbst = tabgeo . '$mtcbst' ;
  1309. $mtcb = tabgeo . '$mtcb' ;
  1310. $mthe = tabgeo . '$mthe' ;
  1311. $sthe = tabgeo . '$sthe' ;
  1312. $mtif = tabgeo . '$mtif' ;
  1313. cfc = tabgeo . 'cfc' ;
  1314. amtcbst = tabgeo . 'amtcbst' ;
  1315. amthe = tabgeo . 'amthe' ;
  1316. * QUAF meshes
  1317. _mtcbst = 'DOMA' $mtcbst 'QUAF' ;
  1318. _mthe = 'DOMA' $mthe 'QUAF' ;
  1319. mtcbst = 'DOMA' $mtcbst 'MAILLAGE' ;
  1320. mtcb = 'DOMA' $mtcb 'MAILLAGE' ;
  1321. 'SI' logst ;
  1322. mtst = 'DIFF' mtcbst mtcb ;
  1323. 'FINSI' ;
  1324. mtst = 'DIFF' mtcbst mtcb ;
  1325. mthe = 'DOMA' $mthe 'MAILLAGE' ;
  1326. mtif = 'DOMA' $mtif 'MAILLAGE' ;
  1327. *
  1328. * Precomputations
  1329. *
  1330. * One wants the height (z) not to be more than four times x or y dimension
  1331. * targetz = 4.D0 ;
  1332. targetz = 1.5D0 ;
  1333. ftour = 0.1D0 ;
  1334. _mtot = 'ET' _mtcbst _mthe ;
  1335. xmt ymt zmt = 'COORDONNEE' _mtot ;
  1336. dx = '-' ('MAXIMUM' xmt) ('MINIMUM' xmt) ;
  1337. dy = '-' ('MAXIMUM' ymt) ('MINIMUM' ymt) ;
  1338. dxy = 'MAXIMUM' ('PROG' dx dy) ;
  1339. dz = '-' ('MAXIMUM' zmt) ('MINIMUM' zmt) ;
  1340. dzdx = '/' dz dx ;
  1341. chzscale = '>' dzdx targetz ;
  1342. 'SI' chzscale ;
  1343. zfactor = '/' dzdx targetz ;
  1344. factech = ('-' ('/' 1.D0 zfactor) 1.D0) ;
  1345. dzmt = 'NOMC' 'UZ' ('*' zmt factech) 'NATURE' 'DISCRET' ;
  1346. orig = 'FORME' ;
  1347. defrm = 'FORME' dzmt ;
  1348. 'FINSI' ;
  1349. *
  1350. * manipulation maillage et champ de temperature
  1351. tcbsc = ('-' (tabres . 'TCBS') 273.15D0) ;
  1352. thec = ('-' (tabres . 'THE') 273.15D0) ;
  1353. cech = tabres . 'H' ;
  1354. nuss0 = tabres . 'nuss0' ;
  1355. reyn0 = tabres . 'reyn0' ;
  1356. pran0 = tabres . 'pran0' ;
  1357. l0 = tabres . 'l0' ;
  1358. Dh = tabres . 'Dh' ;
  1359. uz = 'EXCO' 'UZ' (tabres . 'UHE') ;
  1360. * tournage
  1361. mtot = 'ET' mtcbst mthe ;
  1362. xmt ymt zmt = 'COORDONNEE' mtot ;
  1363. mixmt = 'MINIMUM' xmt ;
  1364. miymt = 'MINIMUM' ymt ;
  1365. mizmt = 'MINIMUM' zmt ;
  1366. dx = '-' ('MAXIMUM' xmt) ('MINIMUM' xmt) ;
  1367. dy = '-' ('MAXIMUM' ymt) ('MINIMUM' ymt) ;
  1368. dz = '-' ('MAXIMUM' zmt) ('MINIMUM' zmt) ;
  1369. p1 = ('-' mixmt ('*' dx ftour))
  1370. ('-' miymt ('*' dy ftour))
  1371. mizmt ;
  1372. p2 = ('-' mixmt ('*' dx ftour))
  1373. ('-' miymt ('*' dy ftour))
  1374. ('+' mizmt 1.D0) ;
  1375. * amtcbst = 'ARETE' mtcbst ;
  1376. * amthe = 'ARETE' mthe ;
  1377. tcbsc2 thec2 mtcbst2 mthe2 amtcbst2 amthe2 =
  1378. 'TOURNER' tcbsc thec mtcbst mthe amtcbst amthe 180. p1 p2 ;
  1379. tcbsct = 'ET' tcbsc tcbsc2 ;
  1380. thect = 'ET' thec thec2 ;
  1381. mtcbstt = 'ET' mtcbst mtcbst2 ;
  1382. mthet = 'ET' mthe mthe2 ;
  1383. amtcbstt = 'ET' amtcbst amtcbst2 ;
  1384. amthet = 'ET' amthe amthe2 ;
  1385. *
  1386. 'SI' interact ;
  1387. mail = ('COULEUR' mtcb 'ROUG')
  1388. 'ET' ('COULEUR' mthe 'BLEU') ;
  1389. 'SI' (logst) ;
  1390. mail = 'ET' mail ('COULEUR' mtst 'BLANC') ;
  1391. 'FINSI' ;
  1392. npomail = 'NBNO' mail ;
  1393. nelmail = 'NBEL' mail ;
  1394. titmail = 'CHAINE' 'Mesh ' 'NBPO=' npomail
  1395. ' NBELEM=' nelmail ;
  1396. TRACMESH mail titmail VRAI ;
  1397. 'FINSI' ;
  1398. *
  1399. * Evol precalc
  1400. *
  1401. 'SI' chzscale ;
  1402. 'FORME' orig ;
  1403. 'FINSI' ;
  1404. nchan = 'DIME' (tabin . 'CHANNEL') ;
  1405. tt = 'TABLE' ;
  1406. tev = 'TABLE' ;
  1407. 'REPETER' ichan nchan ;
  1408. lighe = tabgeo . 'tlchan' . &ichan ;
  1409. evthec = 'EVOL' 'CHPO' thec lighe ;
  1410. APPEND tev 'TEMPERATURE' evthec ;
  1411. evuhe = 'EVOL' 'CHPO' uz lighe ;
  1412. APPEND tev 'VITESSE' evuhe ;
  1413. tt . &ichan = 'CHAINE' 'Canal ' &ichan ;
  1414. 'FIN' ichan ;
  1415. 'SI' chzscale ;
  1416. 'FORME' defrm ;
  1417. 'FINSI' ;
  1418. *
  1419. tcha = 'TABLE' ;
  1420. tcha . 1 = 'T' ;
  1421. tcha . 2 = 'FuelT' ;
  1422. tcha . 3 = 'FuelT2' ;
  1423. tcha . 4 = 'Excoef' ;
  1424. tcha . 5 = 'HeT' ;
  1425. tcha . 6 = 'HeUz' ;
  1426. tcha . 7 = 'HeevT' ;
  1427. tcha . 8 = 'HeevUz' ;
  1428. tcha . 9 = 'Nuss' ;
  1429. tcha . 10 = 'Reyn' ;
  1430. tcha . 11 = 'Prand' ;
  1431. tcha . 12 = 'LamHe' ;
  1432. tcha . 13 = 'Dh' ;
  1433. ntcha = 'DIME' tcha ;
  1434. 'SI' interact ;
  1435. itcha = 1 ;
  1436. noclic = VRAI ;
  1437. 'SINON' ;
  1438. itcha = 'EXTRAIRE' liview iiview ;
  1439. noclic = FAUX ;
  1440. 'FINSI' ;
  1441. *
  1442. 'REPETER' bouc2 ;
  1443. 'SI' interact ;
  1444. 'MESSAGE' 'Noclic allows not to click between each view' ;
  1445. 'MESSAGE'
  1446. 'However, one will deactivate it in order to zoom or save' ;
  1447. noclic = 'CHOI' 'Choose desired options' noclic ;
  1448. 'FINSI' ;
  1449. *
  1450. 'REPETER' bouc1;
  1451. *
  1452. 'SI' ('EGA' itcha 1) ;
  1453. tit = 'CHAINE' 'Temp. (°C)' ;
  1454. tracchpo (tcbsct 'ET' thect)
  1455. (mtcbstt 'ET' mthet)
  1456. (amtcbstt 'ET' amthet)
  1457. tit noclic ;
  1458. 'FINSI' ;
  1459. 'SI' ('EGA' itcha 2) ;
  1460. tit = 'CHAINE' 'Fuel Temp. (°C)' ;
  1461. tracchpo tcbsc mtcbst amtcbst tit noclic ;
  1462. 'FINSI' ;
  1463. 'SI' ('EGA' itcha 3) ;
  1464. tit = 'CHAINE' 'Fuel Temp. (°C)' ;
  1465. tracchpo tcbsct mtcbstt amtcbstt tit noclic ;
  1466. 'FINSI' ;
  1467. 'SI' ('EGA' itcha 4) ;
  1468. tit = 'CHAINE' 'Exchange coeff. (W.m-2.K-1)' ;
  1469. tracchml $mtif cech ('CONTOUR' mtif) tit noclic ;
  1470. 'FINSI' ;
  1471. 'SI' ('EGA' itcha 5) ;
  1472. tit = 'CHAINE' 'Temp. He (°C)' ;
  1473. tracchpo thect mthe amthe tit noclic ;
  1474. 'FINSI' ;
  1475. 'SI' ('EGA' itcha 6) ;
  1476. tit = 'CHAINE' 'Uz He (m.s-1)' ;
  1477. tracchpo uz mthe amthe tit noclic ;
  1478. 'FINSI' ;
  1479. 'SI' ('EGA' itcha 7) ;
  1480. tit = 'CHAINE' 'Helium Temperature' ;
  1481. titxthe = 'CHAINE' 's (m)' ;
  1482. titythe = 'CHAINE' 'T (°C)' ;
  1483. DESSEVOL (tev . 'TEMPERATURE') tt tit titxthe titythe noclic ;
  1484. 'FINSI' ;
  1485. 'SI' ('EGA' itcha 8) ;
  1486. tit = 'CHAINE' 'Helium Vertical Speed' ;
  1487. titxuhe = 'CHAINE' 's (m)' ;
  1488. tityuhe = 'CHAINE' 'uz (m.s-1)' ;
  1489. DESSEVOL (tev . 'VITESSE') tt tit titxuhe tityuhe noclic ;
  1490. 'FINSI' ;
  1491. 'SI' ('EGA' itcha 9) ;
  1492. tit = 'CHAINE' 'Nusselt number' ;
  1493. tracchml $mtif nuss0 ('CONTOUR' mtif) tit noclic ;
  1494. 'FINSI' ;
  1495. 'SI' ('EGA' itcha 10) ;
  1496. tit = 'CHAINE' 'Reynolds number' ;
  1497. tracchml $mtif reyn0 ('CONTOUR' mtif) tit noclic ;
  1498. 'FINSI' ;
  1499. 'SI' ('EGA' itcha 11) ;
  1500. tit = 'CHAINE' 'Prandtl number' ;
  1501. tracchml $mtif pran0 ('CONTOUR' mtif) tit noclic ;
  1502. 'FINSI' ;
  1503. 'SI' ('EGA' itcha 12) ;
  1504. tit = 'CHAINE' 'Lambda (He)' ;
  1505. tracchml $mtif l0 ('CONTOUR' mtif) tit noclic ;
  1506. 'FINSI' ;
  1507. 'SI' ('EGA' itcha 13) ;
  1508. tit = 'CHAINE' 'Hydraulic diameter (m)' ;
  1509. tracchml $mtif Dh ('CONTOUR' mtif) tit noclic ;
  1510. 'FINSI' ;
  1511. *
  1512. 'SI' interact ;
  1513. cha = tit ;
  1514. ret = 'MENU' cha 'Next' 'Previous' 'Options' ;
  1515. 'SI' ('EGA' ret 'Options') ; 'QUITTER' bouc1 ; 'FINSI';
  1516. 'SI' ('EGA' ret 'Quitter') ; 'QUITTER' bouc2; 'FINSI';
  1517. 'SI' ('EGA' ret 'Next') ; itcha = '+' itcha 1 ; 'FINSI' ;
  1518. 'SI' ('EGA' ret 'Previous') ; itcha = '-' itcha 1 ; 'FINSI' ;
  1519. 'SI' (itcha > ntcha); itcha = 1 ; 'FINSI';
  1520. 'SI' (itcha < 1); itcha = ntcha ; 'FINSI';
  1521. 'SINON' ;
  1522. iiview = '+' iiview 1 ;
  1523. 'SI' ('>' iiview niview) ;
  1524. 'QUITTER' bouc2 ;
  1525. 'SINON' ;
  1526. itcha = 'EXTRAIRE' liview iiview ;
  1527. 'FINSI' ;
  1528. 'FINSI' ;
  1529. *
  1530. 'FIN' bouc1;
  1531. 'FIN' bouc2 ;
  1532. *
  1533. 'SI' chzscale ;
  1534. 'FORME' orig ;
  1535. 'FINSI' ;
  1536. *
  1537. * End of procedure file EXPLORES
  1538. *
  1539. 'FINPROC' ;
  1540. *ENDPROCEDUR explores
  1541. *BEGINPROCEDUR genmema
  1542. ************************************************************************
  1543. * NOM : GENMEMA
  1544. * DESCRIPTION : Generate meshes and coupling matrix given base surface
  1545. * mesh
  1546. *
  1547. * Input for GENMEMA procedure
  1548. * tabin . 'INTERFACE' . i : i-th interface (line mesh)
  1549. * tabin . 'CHANNEL' . i : i-th helium channel (surface mesh)
  1550. * tabin . 'FUEL' : fuel mesh (surface mesh)
  1551. * tabin . 'STRUCTURE' : structure mesh (surface mesh) (optional)
  1552. * H : height (m) and nh : number of elements in the height
  1553. * (regular meshing in z direction)
  1554. *
  1555. * Temporary table for GENMEMA procedure
  1556. * tabout . 'INTERFACE' . i : i-th interface (surface mesh)
  1557. * tabout . 'CHANNEL' . i : i-th helium channel (volume mesh)
  1558. * tabout . 'CCONINCH' . i : i-th coupling connectivity intreface <-> channel
  1559. * tabout . 'CMATCHIN' . i : i-th coupling matrix channel -> interface
  1560. * tabout . 'CMATINCH' . i : i-th coupling matrix interface -> channel
  1561. * tabin . 'FUEL' : fuel mesh (volume mesh)
  1562. * tabin . 'STRUCTURE' : structure mesh (volume mesh) (optional)
  1563. *
  1564. * Output table for GENMEMA procedure
  1565. *
  1566. * output tabgeo should contain all the necessary geometric information
  1567. * needed further
  1568. * tabgeo . 'tabin' = tabin
  1569. * tabgeo . 'H' = H : height
  1570. * tabgeo . 'nh' = nh : number of elements in the height
  1571. * tabgeo . '$mtcbst' = NS model objet (fuel+structure)
  1572. * tabgeo . '$mtcb' = NS model objet (fuel only)
  1573. * tabgeo . '$mthe' = NS model objet (helium channels)
  1574. * tabgeo . '$sthe' = NS model objet (bottom of the helium channels)
  1575. * tabgeo . '$mtif' = NS model objet (interfaces)
  1576. * tabgeo . '$mtifb' = NS model objet (blocked interfaces)
  1577. * tabgeo . 'mcf' = coupling matrix helium -> fuel
  1578. * tabgeo . 'mfc' = coupling matrix fuel -> helium
  1579. *
  1580. *
  1581. * LANGAGE : GIBIANE-CAST3M
  1582. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1583. * mél : gounand@semt2.smts.cea.fr
  1584. **********************************************************************
  1585. * VERSION : v1, 09/11/2004, version initiale
  1586. * HISTORIQUE : v1, 09/11/2004, création
  1587. * HISTORIQUE :
  1588. * HISTORIQUE :
  1589. ************************************************************************
  1590. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1591. * en cas de modification de ce sous-programme afin de faciliter
  1592. * la maintenance !
  1593. ************************************************************************
  1594. *
  1595. *
  1596. 'DEBPROC' GENMEMA ;
  1597. 'ARGUMENT' tabin*'TABLE' ;
  1598. 'ARGUMENT' H*'FLOTTANT' ;
  1599. 'ARGUMENT' nh*'ENTIER' ;
  1600. *
  1601. tabout = 'TABLE' ;
  1602. tabout . 'INTERFACE' = 'TABLE' ;
  1603. tabout . 'CHANNEL' = 'TABLE' ;
  1604. tabout . 'CCONINCH' = 'TABLE' ;
  1605. tabout . 'CMATCHIN' = 'TABLE' ;
  1606. tabout . 'CMATINCH' = 'TABLE' ;
  1607. *
  1608. hnh = '/' H ('FLOTTANT' nh) ;
  1609. vechnh = (0. 0. hnh) ;
  1610. *
  1611. * Treatment of everything except 'OTHER'
  1612. *
  1613. ninterf = 'DIME' (tabin . 'INTERFACE') ;
  1614. nchanne = 'DIME' (tabin . 'CHANNEL') ;
  1615. 'SI' ('NEG' ninterf nchanne) ;
  1616. cherr = 'CHAINE' 'NEG (DIME (tabin . INTERFACE)) '
  1617. '(DIME (tabin . CHANNEL))' ;
  1618. 'ERREUR' cherr ;
  1619. 'FINSI' ;
  1620. *
  1621. * Loop on interfaces
  1622. *
  1623. * Préconditionnement
  1624. *
  1625. mott = 'MOTS' 'T' ;
  1626. pr1 = 'PROG' 0.D0 0.D0 ;
  1627. pr3 = 'PROG' 0.D0 1.D0 ;
  1628. *
  1629. 'REPETER' iinterf ninterf ;
  1630. lpreums = vrai ;
  1631. linterf = tabin . 'INTERFACE' . &iinterf ;
  1632. scan = tabin . 'CHANNEL' . &iinterf ;
  1633. * Loop on height
  1634. 'REPETER' ih nh ;
  1635. vectran = (0. 0. ('*' hnh ('FLOTTANT' ('-' &ih 1)))) ;
  1636. tli = 'PLUS' linterf vectran ;
  1637. tsc = 'PLUS' scan vectran ;
  1638. sli = 'TRANSLATION' tli 1 vechnh ;
  1639. vsc = 'VOLUME' tsc 'TRAN' 1 vechnh ;
  1640. cvsc = 'BARYCENTRE' vsc ;
  1641. vvsc = 'MESURE' vsc ;
  1642. ivvsc = '/' 1.D0 vvsc ;
  1643. pr2i = 'PROG' ivvsc 0.D0 ;
  1644. * 'LISTE' cvsc ; 'LISTE' cvsc2 ;
  1645. APPEND (tabout . 'CHANNEL') &iinterf vsc ;
  1646. * Loop on interface elements
  1647. nsli = 'NBEL' sli ;
  1648. 'REPETER' isli nsli ;
  1649. esli = 'ELEM' sli &isli ;
  1650. cesli = 'BARYCENTRE' esli ;
  1651. cco = 'MANUEL' 'SEG2' cesli cvsc ;
  1652. mci = 'MANUEL' 'RIGIDITE' cco mott 'QUEL' pr3 pr1 ;
  1653. * ('PROG' 0.D0 1.D0) ('PROG' 0.D0 0.D0) ;
  1654. mic = 'MANUEL' 'RIGIDITE' cco mott 'QUEL' pr1 pr2i ;
  1655. 'SI' lpreums ;
  1656. tabout . 'INTERFACE' . &iinterf = esli ;
  1657. tabout . 'CCONINCH' . &iinterf = cco ;
  1658. tabout . 'CMATCHIN' . &iinterf = mci ;
  1659. tabout . 'CMATINCH' . &iinterf = mic ;
  1660. lpreums = faux ;
  1661. 'SINON' ;
  1662. tabout . 'INTERFACE' . &iinterf = 'ET'
  1663. (tabout . 'INTERFACE' . &iinterf) esli ;
  1664. tabout . 'CCONINCH' . &iinterf = 'ET'
  1665. (tabout . 'CCONINCH' . &iinterf) cco ;
  1666. tabout . 'CMATCHIN' . &iinterf = 'ET'
  1667. (tabout . 'CMATCHIN' . &iinterf) mci ;
  1668. tabout . 'CMATINCH' . &iinterf = 'ET'
  1669. (tabout . 'CMATINCH' . &iinterf) mic ;
  1670. 'FINSI' ;
  1671. 'FIN' isli ;
  1672. 'FIN' ih ;
  1673. 'FIN' iinterf ;
  1674. *
  1675. * Treatment of 'FUEL' and 'STRUCTURE'
  1676. *
  1677. sother = tabin . 'FUEL' ;
  1678. vother = 'VOLUME' sother 'TRAN' nh (0. 0. H) ;
  1679. tabout . 'FUEL' = vother ;
  1680. tabout . 'FUEL2' = 'VOLUME' sother 'TRAN' 1 (0. 0. H) ;
  1681. 'SI' ('EXISTE' tabin 'STRUCTURE') ;
  1682. sother = tabin . 'STRUCTURE' ;
  1683. vother = 'VOLUME' sother 'TRAN' nh (0. 0. H) ;
  1684. tabout . 'STRUCTURE' = vother ;
  1685. tabout . 'STRUCT2' = 'VOLUME' sother 'TRAN' 1 (0. 0. H) ;
  1686. 'FINSI' ;
  1687. *
  1688. * Some eliminations
  1689. *
  1690. tinter = @STBL (tabout . 'INTERFACE') ;
  1691. tother = tabout . 'FUEL' ;
  1692. 'SI' ('EXISTE' tabout 'STRUCTURE') ;
  1693. tother = 'ET' tother (tabout . 'STRUCTURE') ;
  1694. 'FINSI' ;
  1695. 'ELIMINATION' ('ET' tinter tother) 1.D-6 ;
  1696. *
  1697. * Second part : tabgeo
  1698. *
  1699. tabgeo = 'TABLE' ;
  1700. *
  1701. * Build the global meshes
  1702. *
  1703. * Structure & Combustible
  1704. mtcb = tabout . 'FUEL' ;
  1705. amtcb = 'ARETE' (tabout . 'FUEL2') ;
  1706. 'SI' ('EXISTE' tabout 'STRUCTURE') ;
  1707. mtcbst = 'ET' mtcb (tabout . 'STRUCTURE') ;
  1708. amtcbst = 'ET' amtcb ('ARETE' (tabout . 'STRUCT2')) ;
  1709. 'SINON' ;
  1710. mtcbst = mtcb ;
  1711. amtcbst = amtcb ;
  1712. 'FINSI' ;
  1713. * Channels
  1714. *mthe = @STBL (tabout . 'CHANNEL') ;
  1715. tmthe = tabout . 'CHANNEL' ;
  1716. sthe = @STBL (tabin . 'CHANNEL') ;
  1717. amthe = 'TRANSLATION' ('CONTOUR' sthe) 1 (0. 0. H) ;
  1718. * Line in channels
  1719. nchan = 'DIME' (tabin . 'CHANNEL') ;
  1720. tlchan = 'TABLE' ;
  1721. tpechan = 'TABLE' ;
  1722. tpschan = 'TABLE' ;
  1723. 'REPETER' ichan nchan ;
  1724. selem1 = 'ELEM' (tabin . 'CHANNEL' . &ichan) 1 ;
  1725. po1 = 'POIN' ('CONTOUR' selem1) 1 ;
  1726. po2 = 'PLUS' po1 (0. 0. H) ;
  1727. lighe = 'DROIT' nh po1 po2 ;
  1728. tlchan . &ichan = lighe ;
  1729. tpechan . &ichan = po1 ;
  1730. tpschan . &ichan = po2 ;
  1731. 'FIN' ichan ;
  1732. * Interfaces
  1733. tmtif = tabout . 'INTERFACE' ;
  1734. mtif = @STBL (tabout . 'INTERFACE') ;
  1735. * Blocked interfaces
  1736. lblock = tabin . 'BLOCKED' ;
  1737. dblock = 'DIME' lblock ;
  1738. logb = ('>' dblock 0) ;
  1739. 'SI' logb ;
  1740. tchan = 'TABLE' ;
  1741. 'REPETER' iblock dblock ;
  1742. iib = 'EXTRAIRE' lblock &iblock ;
  1743. APPEND tchan 'mtifb' (tabout . 'INTERFACE' . iib) ;
  1744. 'FIN' iblock ;
  1745. mtifb = tchan . 'mtifb' ;
  1746. 'FINSI' ;
  1747. * Coupling
  1748. cfc = @STBL (tabout . 'CCONINCH') ;
  1749. mcf = @STBL (tabout . 'CMATCHIN') ;
  1750. mfc = @STBL (tabout . 'CMATINCH') ;
  1751. mcf = 'CHANGER' mcf 'INCO' ('MOTS' 'T') ('MOTS' 'SCAL')
  1752. ('MOTS' 'Q') ('MOTS' 'SCAL') ;
  1753. mfc = 'CHANGER' mfc 'INCO' ('MOTS' 'T') ('MOTS' 'SCAL')
  1754. ('MOTS' 'Q') ('MOTS' 'SCAL') ;
  1755. * Generate the QUAF meshes
  1756. * Channels
  1757. nhe = 'DIME' tmthe ;
  1758. _tmthe = 'TABLE' ;
  1759. 'REPETER' ihe nhe ;
  1760. _tmthe . &ihe = QUAFME (tmthe . &ihe) ;
  1761. 'FIN' ihe ;
  1762. _mthe = @STBL _tmthe ;
  1763. * Interface
  1764. nif = 'DIME' tmtif ;
  1765. _tmtif = 'TABLE' ;
  1766. 'REPETER' iif nif ;
  1767. _tmtif . &iif = QUAFME (tmtif . &iif) ;
  1768. 'FIN' iif ;
  1769. _mtif = @STBL _tmtif ;
  1770. * Other
  1771. _mtcbst _mtcb _sthe =
  1772. QUAFME mtcbst mtcb sthe ;
  1773. mcbt = _mtcbst 'ET' _mtcb 'ET' _mtif 'ET' cfc
  1774. 'ET' amtcb 'ET' amtcbst ;
  1775. 'SI' logb ;
  1776. _mtifb = QUAFME mtifb ;
  1777. mcbt = 'ET' mcbt _mtifb ;
  1778. 'FINSI' ;
  1779. * Elimination of points with same coordinates
  1780. 'ELIMINATION' mcbt 1.D-6 ;
  1781. ttlchan = @STBL tlchan ;
  1782. 'ELIMINATION' (_mthe 'ET' _sthe 'ET' cfc 'ET' amthe 'ET' ttlchan)
  1783. 1.D-6 ;
  1784. * Create the Navier-Stokes model objects
  1785. * Channels
  1786. $tmthe = 'TABLE' ;
  1787. 'REPETER' ihe nhe ;
  1788. $tmthe . &ihe = MODNAV 'LINE' (_tmthe . &ihe) ;
  1789. 'FIN' ihe ;
  1790. * Interface
  1791. $tmtif = 'TABLE' ;
  1792. 'REPETER' iif nif ;
  1793. $tmtif . &iif = MODNAV 'LINE' (_tmtif . &iif) ;
  1794. 'FIN' iif ;
  1795. $mtcbst $mtcb $mthe $mtif $sthe =
  1796. MODNAV 'LINE' _mtcbst _mtcb _mthe _mtif _sthe ;
  1797. * Create the hydraulic diameter table
  1798. tdhif = 'TABLE' ;
  1799. 'REPETER' iif nif ;
  1800. tdhif . &iif = 'KCHT' ($tmtif . &iif) 'SCAL' 'CENTRE'
  1801. (tabin . 'DH' .&iif) ;
  1802. 'FIN' iif ;
  1803. dh = @STBL tdhif ;
  1804. *
  1805. * Store results
  1806. *
  1807. tabgeo . 'tabin' = tabin ;
  1808. tabgeo . 'H' = H ;
  1809. tabgeo . 'nh' = nh ;
  1810. tabgeo . '$mtcbst' = $mtcbst ;
  1811. tabgeo . '$mtcb' = $mtcb ;
  1812. tabgeo . '$tmthe' = $tmthe ;
  1813. tabgeo . '$mthe' = $mthe ;
  1814. tabgeo . '$sthe' = $sthe ;
  1815. tabgeo . '$mtif' = $mtif ;
  1816. tabgeo . 'amtcb' = amtcb ;
  1817. tabgeo . 'amtcbst' = amtcbst ;
  1818. tabgeo . 'amthe' = amthe ;
  1819. tabgeo . 'mcf' = mcf ;
  1820. tabgeo . 'mfc' = mfc ;
  1821. tabgeo . 'cfc' = cfc ;
  1822. 'SI' logb ;
  1823. $mtifb = MODNAV 'LINE' _mtifb ;
  1824. tabgeo . '$mtifb' = $mtifb ;
  1825. 'FINSI' ;
  1826. tabgeo . 'Dh' = dh ;
  1827. tabgeo . 'tlchan' = tlchan ;
  1828. tabgeo . 'tpechan' = tpechan ;
  1829. tabgeo . 'tpschan' = tpschan ;
  1830. 'RESPRO' tabgeo ;
  1831. *
  1832. * End of procedure file GENMEMA
  1833. *
  1834. 'FINPROC' ;
  1835. *ENDPROCEDUR genmema
  1836. *BEGINPROCEDUR geomhex1
  1837. ************************************************************************
  1838. * NOM : GEOMHEX1
  1839. * DESCRIPTION : 30° symmetry cell of an hexagonal geometry
  1840. * in the x-y plane
  1841. *
  1842. *
  1843. *
  1844. * LANGAGE : GIBIANE-CAST3M
  1845. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1846. * mél : gounand@semt2.smts.cea.fr
  1847. **********************************************************************
  1848. * VERSION : v1, ??/??/2004, version initiale
  1849. * HISTORIQUE : v1, ??/??/2004, création
  1850. * HISTORIQUE :
  1851. * HISTORIQUE :
  1852. ************************************************************************
  1853. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1854. * en cas de modification de ce sous-programme afin de faciliter
  1855. * la maintenance !
  1856. ************************************************************************
  1857. *
  1858. *
  1859. 'DEBPROC' GEOMHEX1 ;
  1860. 'ARGUMENT' Dh*'FLOTTANT' ;
  1861. 'ARGUMENT' pas*'FLOTTANT' ;
  1862. *
  1863. * Geometric quantities deduced from the one given above
  1864. *
  1865. q = '/' pas 2.D0 ;
  1866. R = '/' Dh 2.D0 ;
  1867. *
  1868. * Geometric discretization parameters
  1869. * (number of elements)
  1870. * nb (base) : number of elements for the line in (x-y) plane
  1871. * with smallest length
  1872. *
  1873. nb = 7 ;
  1874. s30 = 'SIN' 30.D0 ;
  1875. c30 = 'COS' 30.D0 ;
  1876. t30 = '/' s30 c30 ;
  1877. * length of each line
  1878. lcer = ('*' ('/' PI 6.D0) R) ;
  1879. lpdia = '-' q R ;
  1880. lgdia = '-' ('/' q c30) R ;
  1881. lhex = ('*' q t30) ;
  1882. * scaling based on shortest line
  1883. lbase = 'MINIMUM' ('PROG' lcer lpdia lgdia lhex) ;
  1884. * factors in order to have an almost regular mesh
  1885. fcer = '/' lcer lbase ;
  1886. fpdia = '/' lpdia lbase ;
  1887. fgdia = '/' lgdia lbase ;
  1888. fhex = '/' lhex lbase ;
  1889. * mesh
  1890. rbase = 'FLOTTANT' nb ;
  1891. ncer = '*' rbase fcer ;
  1892. nhex = '*' rbase fhex ;
  1893. npdia = '*' rbase fpdia ;
  1894. ngdia = '*' rbase fgdia ;
  1895. *
  1896. ncer = 'ENTIER' ('+' ncer 0.99D0) ;
  1897. nhex = 'ENTIER' ('+' nhex 0.99D0) ;
  1898. npdia = 'ENTIER' ('+' npdia 0.99D0) ;
  1899. ngdia = 'ENTIER' ('+' ngdia 0.99D0) ;
  1900. * Points definition for fuel
  1901. p0 = 0.D0 0.D0 0.D0 ;
  1902. p1 = R 0.D0 0.D0 ;
  1903. p2 = q 0.D0 0.D0 ;
  1904. p3 = q ('*' q t30) 0.D0 ;
  1905. p4 = ('*' R c30) ('*' R s30) 0.D0 ;
  1906. * Lines definition for fuel
  1907. l1 = 'DROIT' npdia p1 p2 ;
  1908. l2 = 'DROIT' nhex p2 p3 ;
  1909. l3 = 'DROIT' ngdia p3 p4 ;
  1910. l4 = 'CERCLE' ncer p4 p0 p1 ;
  1911. * Surfaces definition for fuel
  1912. ctn = l1 'ET' l2 'ET' l3 'ET' l4 ;
  1913. stcb = 'SURFACE' ctn 'PLANE' ;
  1914. * Points and surface definitions for helium (an isocele triangle with
  1915. * surface equal to the corresponding circular sector
  1916. Rp = '*' R ('**' ('/' PI 3.D0) 0.5D0) ;
  1917. p5 = Rp 0.D0 0.D0 ;
  1918. p6 = ('*' Rp c30) ('*' Rp s30) 0.D0 ;
  1919. sthe = 'MANUEL' 'TRI3' p0 p5 p6 ;
  1920. *
  1921. * Output results in a table suitable for GENMEMA
  1922. *
  1923. tabin = 'TABLE' ;
  1924. tabin . 'INTERFACE' = 'TABLE' ;
  1925. tabin . 'CHANNEL' = 'TABLE' ;
  1926. *
  1927. tabin . 'INTERFACE' . 1 = l4 ;
  1928. tabin . 'CHANNEL' . 1 = sthe ;
  1929. tabin . 'FUEL' = stcb ;
  1930. 'RESPRO' tabin ;
  1931. *
  1932. * End of procedure file GEOMHEX1
  1933. *
  1934. 'FINPROC' ;
  1935. *ENDPROCEDUR geomhex1
  1936. *BEGINPROCEDUR geomhex2
  1937. ************************************************************************
  1938. * NOM : GEOMHEX2
  1939. * DESCRIPTION : Same as GEOMHEX1 but larger symmetry cell
  1940. * in the x-y plane
  1941. *
  1942. *
  1943. *
  1944. * LANGAGE : GIBIANE-CAST3M
  1945. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1946. * mél : gounand@semt2.smts.cea.fr
  1947. **********************************************************************
  1948. * VERSION : v1, 18/11/2004, version initiale
  1949. * HISTORIQUE : v1, 18/11/2004, création
  1950. * HISTORIQUE :
  1951. * HISTORIQUE :
  1952. ************************************************************************
  1953. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1954. * en cas de modification de ce sous-programme afin de faciliter
  1955. * la maintenance !
  1956. ************************************************************************
  1957. *
  1958. *
  1959. 'DEBPROC' GEOMHEX2 ;
  1960. 'ARGUMENT' Dh*'FLOTTANT' ;
  1961. 'ARGUMENT' pas*'FLOTTANT' ;
  1962. *
  1963. * Geometric quantities deduced from the one given above
  1964. *
  1965. q = '/' pas 2.D0 ;
  1966. R = '/' Dh 2.D0 ;
  1967. *
  1968. * Geometric discretization parameters
  1969. * (number of elements)
  1970. * nb (base) : number of elements for the line in (x-y) plane
  1971. * with smallest length
  1972. *
  1973. nb = 7 ;
  1974. s30 = 'SIN' 30.D0 ;
  1975. c30 = 'COS' 30.D0 ;
  1976. t30 = '/' s30 c30 ;
  1977. * length of each line
  1978. lcera = ('*' ('/' PI 6.D0) R) ;
  1979. lcerb = ('*' ('/' PI 2.D0) R) ;
  1980. lpdia = '-' pas Dh ;
  1981. lgdia = '-' ('/' pas c30) R ;
  1982. lhex = '-' ('*' pas t30) R ;
  1983. * scaling based on shortest line
  1984. lbase = 'MINIMUM' ('PROG' lcera lcerb lpdia lgdia lhex) ;
  1985. * factors in order to have an almost regular mesh
  1986. fcera = '/' lcera lbase ;
  1987. fcerb = '/' lcerb lbase ;
  1988. fpdia = '/' lpdia lbase ;
  1989. fgdia = '/' lgdia lbase ;
  1990. fhex = '/' lhex lbase ;
  1991. * mesh
  1992. rbase = 'FLOTTANT' nb ;
  1993. ncera = '*' rbase fcera ;
  1994. ncerb = '*' rbase fcerb ;
  1995. nhex = '*' rbase fhex ;
  1996. npdia = '*' rbase fpdia ;
  1997. ngdia = '*' rbase fgdia ;
  1998. *
  1999. ncera = 'ENTIER' ('+' ncera 0.99D0) ;
  2000. ncerb = 'ENTIER' ('+' ncerb 0.99D0) ;
  2001. nhex = 'ENTIER' ('+' nhex 0.99D0) ;
  2002. npdia = 'ENTIER' ('+' npdia 0.99D0) ;
  2003. ngdia = 'ENTIER' ('+' ngdia 0.99D0) ;
  2004. * Points definition for fuel
  2005. p0 = 0.D0 0.D0 0.D0 ;
  2006. p1 = R 0.D0 0.D0 ;
  2007. p2 = ('-' pas R) 0.D0 0.D0 ;
  2008. p3 = pas 0.D0 0.D0 ;
  2009. p4 = pas R 0.D0 ;
  2010. p5 = pas ('*' pas t30) 0.D0 ;
  2011. p6 = ('*' R c30) ('*' R s30) 0.D0 ;
  2012. * Lines definition for fuel
  2013. l1 = 'DROIT' npdia p1 p2 ;
  2014. l2 = 'CERCLE' ncerb p2 p3 p4 ;
  2015. l3 = 'DROIT' nhex p4 p5 ;
  2016. l4 = 'DROIT' ngdia p5 p6 ;
  2017. l5 = 'CERCLE' ncera p6 p0 p1 ;
  2018. * Surfaces definition for fuel
  2019. ctn = l1 'ET' l2 'ET' l3 'ET' l4 'ET' l5 ;
  2020. stcb = 'SURFACE' ctn 'PLANE' ;
  2021. * Points and surface definitions for helium (two isocele triangles with
  2022. * surface equal to the corresponding circular sector
  2023. Rpa = '*' R ('**' ('/' PI 3.D0) 0.5D0) ;
  2024. p7 = Rpa 0.D0 0.D0 ;
  2025. p8 = ('*' Rpa c30) ('*' Rpa s30) 0.D0 ;
  2026. sthea = 'MANUEL' 'TRI3' p0 p7 p8 ;
  2027. Rpb = '*' R ('**' ('/' PI 2.D0) 0.5D0) ;
  2028. p9 = ('-' pas Rpb) 0.D0 0.D0 ;
  2029. p10 = pas Rpb 0.D0 ;
  2030. stheb = 'MANUEL' 'TRI3' p9 p3 p10 ;
  2031. *
  2032. * Output results in a table suitable for GENMEMA
  2033. *
  2034. tabin = 'TABLE' ;
  2035. tabin . 'INTERFACE' = 'TABLE' ;
  2036. tabin . 'CHANNEL' = 'TABLE' ;
  2037. *
  2038. tabin . 'INTERFACE' . 1 = l5 ;
  2039. tabin . 'CHANNEL' . 1 = sthea ;
  2040. tabin . 'INTERFACE' . 2 = l2 ;
  2041. tabin . 'CHANNEL' . 2 = stheb ;
  2042. tabin . 'FUEL' = stcb ;
  2043. 'RESPRO' tabin ;
  2044. *
  2045. * End of procedure file GEOMHEX2
  2046. *
  2047. 'FINPROC' ;
  2048. *ENDPROCEDUR geomhex2
  2049. *BEGINPROCEDUR geompl21
  2050. ************************************************************************
  2051. * NOM : GEOMPL21
  2052. * DESCRIPTION : Type 1 symmetry cell for GEOMPLA2
  2053. *
  2054. *
  2055. *
  2056. * LANGAGE : GIBIANE-CAST3M
  2057. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  2058. * mél : gounand@semt2.smts.cea.fr
  2059. **********************************************************************
  2060. * VERSION : v1, 23/11/2004, version initiale
  2061. * HISTORIQUE : v1, 23/11/2004, création
  2062. * HISTORIQUE :
  2063. * HISTORIQUE :
  2064. ************************************************************************
  2065. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  2066. * en cas de modification de ce sous-programme afin de faciliter
  2067. * la maintenance !
  2068. ************************************************************************
  2069. *
  2070. *
  2071. 'DEBPROC' GEOMPL21 ;
  2072. 'ARGUMENT' Dh*'FLOTTANT' ;
  2073. 'ARGUMENT' ef*'FLOTTANT' ;
  2074. 'ARGUMENT' ep*'FLOTTANT' ;
  2075. 'ARGUMENT' nchan*'ENTIER' ;
  2076. 'ARGUMENT' nc2*'ENTIER' ;
  2077. 'ARGUMENT' nf*'ENTIER' ;
  2078. 'ARGUMENT' np*'ENTIER' ;
  2079. *
  2080. 'SI' ('NEG' (MODULO nchan 2) 1) ;
  2081. cherr = 'CHAINE' 'nchan should be odd' ;
  2082. 'FINSI' ;
  2083. *
  2084. * Geometric quantities deduced from the one given above
  2085. *
  2086. ec = '/' Dh 2.D0 ;
  2087. ec2 = '/' ec 2 ;
  2088. nplate = '+' nchan 1 ;
  2089. L2 = '+' ('*' nplate ep) ('*' nchan ec) '+' ('*' ef 2) ;
  2090. L4 = '/' L2 2.D0 ;
  2091. *
  2092. * Discretisation
  2093. *
  2094. nplate2 = '/' nplate 2 ;
  2095. nc = '*' nc2 2 ;
  2096. *
  2097. tabin = 'TABLE' ;
  2098. tabin . 'INTERFACE' = 'TABLE' ;
  2099. tabin . 'CHANNEL' = 'TABLE' ;
  2100. iitf = 1 ;
  2101. *
  2102. * Part1 : Lines
  2103. *
  2104. p0 = 0. 0. 0. ;
  2105. p1 = 0. ('*' ef -1.D0) 0. ;
  2106. lcor = 'DROIT' nf p0 p1 ;
  2107. tablig = 'TABLE' ;
  2108. bp = p1 ;
  2109. 'REPETER' ipl nplate2 ;
  2110. p2 = 'PLUS' bp (0. ('*' ep -1.D0) 0.) ;
  2111. APPEND tablig 'LIG' ('DROIT' bp p2 np) ;
  2112. bp = p2 ;
  2113. * The last one is an half channel
  2114. 'SI' ('NEG' &ipl nplate2) ;
  2115. p2 = 'PLUS' bp (0. ('*' ec -1.D0) 0.) ;
  2116. APPEND tablig 'LIG' ('DROIT' bp p2 nc) ;
  2117. bp = p2 ;
  2118. 'SINON' ;
  2119. p2 = 'PLUS' bp (0. ('*' ec2 -1.D0) 0.) ;
  2120. APPEND tablig 'LIG' ('DROIT' bp p2 nc2) ;
  2121. bp = p2 ;
  2122. 'FINSI' ;
  2123. 'FIN' ipl ;
  2124. lcb = tablig . 'LIG' ;
  2125. p2 = 'PLUS' p0 bp ;
  2126. lch = 'DROIT' p1 p2 1 ;
  2127. *
  2128. * Part1 : left structure
  2129. *
  2130. bp = 0. 0. 0. ;
  2131. vt = ef 0. 0. ;
  2132. APPEND tabin 'STRUCTURE' ('TRANSLATION' (lcor 'ET' lcb) nf vt) ;
  2133. bp = 'PLUS' bp vt ;
  2134. *
  2135. * Loop on plates
  2136. *
  2137. 'REPETER' iplate nplate ;
  2138. * Structure part
  2139. vt = ep 0. 0. ;
  2140. lcort = 'PLUS' lcor bp ;
  2141. APPEND tabin 'STRUCTURE' ('TRANSLATION' lcort np vt) ;
  2142. * Fuel part
  2143. lcbt = 'PLUS' lcb bp ;
  2144. APPEND tabin 'FUEL' ('TRANSLATION' lcbt np vt) ;
  2145. lcbtt = 'PLUS' lcbt vt ;
  2146. 'SI' ('>' &iplate 1) ;
  2147. APPEND (tabin . 'INTERFACE') ('-' iitf 1) lcbt ;
  2148. 'FINSI' ;
  2149. 'SI' ('<' &iplate nplate) ;
  2150. APPEND (tabin . 'INTERFACE') iitf lcbtt ;
  2151. 'FINSI' ;
  2152. bp = 'PLUS' bp vt ;
  2153. 'SI' ('<' &iplate nplate) ;
  2154. * Structure part
  2155. vt = ec 0. 0. ;
  2156. lcort = 'PLUS' lcor bp ;
  2157. p1t = 'PLUS' p1 bp ;
  2158. p2t = 'PLUS' p1t vt ;
  2159. APPEND tabin 'STRUCTURE' ('TRANSLATION' lcort nc vt) ;
  2160. APPEND (tabin . 'INTERFACE') iitf ('DROIT' p1t p2t nc) ;
  2161. * Channel part
  2162. lcht = 'PLUS' lch bp ;
  2163. APPEND (tabin . 'CHANNEL') iitf ('TRANSLATION' lcht 1 vt) ;
  2164. iitf = '+' iitf 1 ;
  2165. bp = 'PLUS' bp vt ;
  2166. 'FINSI' ;
  2167. 'FIN' iplate ;
  2168. * Part1 : right structure
  2169. vt = ef 0. 0. ;
  2170. lcct = 'PLUS' ('ET' lcor lcb) bp ;
  2171. APPEND tabin 'STRUCTURE' ('TRANSLATION' lcct nf vt) ;
  2172. *
  2173. 'RESPRO' tabin ;
  2174. *
  2175. * End of procedure file GEOMPL21
  2176. *
  2177. 'FINPROC' ;
  2178. *ENDPROCEDUR geompl21
  2179. *BEGINPROCEDUR geompl22
  2180. ************************************************************************
  2181. * NOM : GEOMPL22
  2182. * DESCRIPTION : Type 2 symmetry cell for GEOMPLA2
  2183. *
  2184. *
  2185. *
  2186. * LANGAGE : GIBIANE-CAST3M
  2187. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  2188. * mél : gounand@semt2.smts.cea.fr
  2189. **********************************************************************
  2190. * VERSION : v1, 23/11/2004, version initiale
  2191. * HISTORIQUE : v1, 23/11/2004, création
  2192. * HISTORIQUE :
  2193. * HISTORIQUE :
  2194. ************************************************************************
  2195. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  2196. * en cas de modification de ce sous-programme afin de faciliter
  2197. * la maintenance !
  2198. ************************************************************************
  2199. *
  2200. *
  2201. 'DEBPROC' GEOMPL22 ;
  2202. 'ARGUMENT' Dh*'FLOTTANT' ;
  2203. 'ARGUMENT' ef*'FLOTTANT' ;
  2204. 'ARGUMENT' ep*'FLOTTANT' ;
  2205. 'ARGUMENT' nchan*'ENTIER' ;
  2206. 'ARGUMENT' nc2*'ENTIER' ;
  2207. 'ARGUMENT' nf*'ENTIER' ;
  2208. 'ARGUMENT' np*'ENTIER' ;
  2209. *
  2210. 'SI' ('NEG' (MODULO nchan 2) 1) ;
  2211. cherr = 'CHAINE' 'nchan should be odd' ;
  2212. 'FINSI' ;
  2213. *
  2214. * Geometric quantities deduced from the one given above
  2215. *
  2216. ec = '/' Dh 2.D0 ;
  2217. ec2 = '/' ec 2 ;
  2218. nplate = '+' nchan 1 ;
  2219. L2 = '+' ('*' nplate ep) ('*' nchan ec) '+' ('*' ef 2) ;
  2220. L4 = '/' L2 2.D0 ;
  2221. *
  2222. * Discretisation
  2223. *
  2224. nplate2 = '/' nplate 2 ;
  2225. nc = '*' nc2 2 ;
  2226. *
  2227. tabin = 'TABLE' ;
  2228. tabin . 'INTERFACE' = 'TABLE' ;
  2229. tabin . 'CHANNEL' = 'TABLE' ;
  2230. iitf = 1 ;
  2231. *
  2232. * Part1 : Lines
  2233. *
  2234. p0 = 0. 0. 0. ;
  2235. p1 = 0. ('*' ef -1.D0) 0. ;
  2236. lcor = 'DROIT' nf p0 p1 ;
  2237. tablig = 'TABLE' ;
  2238. bp = p1 ;
  2239. 'REPETER' ipl nplate2 ;
  2240. p2 = 'PLUS' bp (0. ('*' ep -1.D0) 0.) ;
  2241. APPEND tablig 'LIG' ('DROIT' bp p2 np) ;
  2242. bp = p2 ;
  2243. * The last one is an half channel
  2244. 'SI' ('NEG' &ipl nplate2) ;
  2245. p2 = 'PLUS' bp (0. ('*' ec -1.D0) 0.) ;
  2246. APPEND tablig 'LIG' ('DROIT' bp p2 nc) ;
  2247. bp = p2 ;
  2248. 'SINON' ;
  2249. p2 = 'PLUS' bp (0. ('*' ec2 -1.D0) 0.) ;
  2250. APPEND tablig 'LIG' ('DROIT' bp p2 nc2) ;
  2251. bp = p2 ;
  2252. 'FINSI' ;
  2253. 'FIN' ipl ;
  2254. lcb = tablig . 'LIG' ;
  2255. p2 = 'PLUS' p0 bp ;
  2256. lch = 'DROIT' p1 p2 1 ;
  2257. *
  2258. * Part1 : left structure
  2259. *
  2260. bp = 0. 0. 0. ;
  2261. vt = ef 0. 0. ;
  2262. APPEND tabin 'STRUCTURE' ('TRANSLATION' (lcor 'ET' lcb) nf vt) ;
  2263. bp = 'PLUS' bp vt ;
  2264. *
  2265. * Loop on plates
  2266. *
  2267. 'REPETER' iplate nplate2 ;
  2268. * Structure part
  2269. vt = ep 0. 0. ;
  2270. lcort = 'PLUS' lcor bp ;
  2271. APPEND tabin 'STRUCTURE' ('TRANSLATION' lcort np vt) ;
  2272. * Fuel part
  2273. lcbt = 'PLUS' lcb bp ;
  2274. APPEND tabin 'FUEL' ('TRANSLATION' lcbt np vt) ;
  2275. lcbtt = 'PLUS' lcbt vt ;
  2276. 'SI' ('>' &iplate 1) ;
  2277. APPEND (tabin . 'INTERFACE') ('-' iitf 1) lcbt ;
  2278. 'FINSI' ;
  2279. APPEND (tabin . 'INTERFACE') iitf lcbtt ;
  2280. bp = 'PLUS' bp vt ;
  2281. 'SI' ('<' &iplate nplate2) ;
  2282. * Structure part
  2283. vt = ec 0. 0. ;
  2284. lcort = 'PLUS' lcor bp ;
  2285. p1t = 'PLUS' p1 bp ;
  2286. p2t = 'PLUS' p1t vt ;
  2287. APPEND tabin 'STRUCTURE' ('TRANSLATION' lcort nc vt) ;
  2288. APPEND (tabin . 'INTERFACE') iitf ('DROIT' p1t p2t nc) ;
  2289. * Channel part
  2290. lcht = 'PLUS' lch bp ;
  2291. APPEND (tabin . 'CHANNEL') iitf ('TRANSLATION' lcht 1 vt) ;
  2292. iitf = '+' iitf 1 ;
  2293. bp = 'PLUS' bp vt ;
  2294. * The last one is a half channel
  2295. 'SINON' ;
  2296. * Structure part
  2297. vt = ec2 0. 0. ;
  2298. lcort = 'PLUS' lcor bp ;
  2299. p1t = 'PLUS' p1 bp ;
  2300. p2t = 'PLUS' p1t vt ;
  2301. APPEND tabin 'STRUCTURE' ('TRANSLATION' lcort nc2 vt) ;
  2302. APPEND (tabin . 'INTERFACE') iitf ('DROIT' p1t p2t nc2) ;
  2303. * Channel part
  2304. lcht = 'PLUS' lch bp ;
  2305. APPEND (tabin . 'CHANNEL') iitf ('TRANSLATION' lcht 1 vt) ;
  2306. iitf = '+' iitf 1 ;
  2307. 'FINSI' ;
  2308. 'FIN' iplate ;
  2309. *
  2310. 'RESPRO' tabin ;
  2311. *
  2312. * End of procedure file GEOMPL22
  2313. *
  2314. 'FINPROC' ;
  2315. *ENDPROCEDUR geompl22
  2316. *BEGINPROCEDUR geompl23
  2317. ************************************************************************
  2318. * NOM : GEOMPL23
  2319. * DESCRIPTION : Type 3 symmetry cell for GEOMPLA2
  2320. *
  2321. *
  2322. *
  2323. * LANGAGE : GIBIANE-CAST3M
  2324. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  2325. * mél : gounand@semt2.smts.cea.fr
  2326. **********************************************************************
  2327. * VERSION : v1, 23/11/2004, version initiale
  2328. * HISTORIQUE : v1, 23/11/2004, création
  2329. * HISTORIQUE :
  2330. * HISTORIQUE :
  2331. ************************************************************************
  2332. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  2333. * en cas de modification de ce sous-programme afin de faciliter
  2334. * la maintenance !
  2335. ************************************************************************
  2336. *
  2337. *
  2338. 'DEBPROC' GEOMPL23 ;
  2339. 'ARGUMENT' Dh*'FLOTTANT' ;
  2340. 'ARGUMENT' ef*'FLOTTANT' ;
  2341. 'ARGUMENT' ep*'FLOTTANT' ;
  2342. 'ARGUMENT' nchan*'ENTIER' ;
  2343. 'ARGUMENT' nc2*'ENTIER' ;
  2344. 'ARGUMENT' nf*'ENTIER' ;
  2345. 'ARGUMENT' np*'ENTIER' ;
  2346. *
  2347. 'SI' ('NEG' (MODULO nchan 2) 1) ;
  2348. cherr = 'CHAINE' 'nchan should be odd' ;
  2349. 'FINSI' ;
  2350. *
  2351. * Geometric quantities deduced from the one given above
  2352. *
  2353. ec = '/' Dh 2.D0 ;
  2354. ec2 = '/' ec 2 ;
  2355. nplate = '+' nchan 1 ;
  2356. L2 = '+' ('*' nplate ep) ('*' nchan ec) '+' ('*' ef 2) ;
  2357. L4 = '/' L2 2.D0 ;
  2358. *
  2359. * Discretisation
  2360. *
  2361. nplate2 = '/' nplate 2 ;
  2362. nc = '*' nc2 2 ;
  2363. *
  2364. tabin = 'TABLE' ;
  2365. tabin . 'INTERFACE' = 'TABLE' ;
  2366. tabin . 'CHANNEL' = 'TABLE' ;
  2367. iitf = 1 ;
  2368. *
  2369. * Part1 : Lines
  2370. *
  2371. p0 = 0. 0. 0. ;
  2372. p1 = ef 0. 0. ;
  2373. lcorg = 'DROIT' nf p0 p1 ;
  2374. tablig = 'TABLE' ;
  2375. bp = p1 ;
  2376. 'REPETER' iplate nplate ;
  2377. p2 = 'PLUS' bp (ep 0. 0.) ;
  2378. APPEND tablig 'LIG' ('DROIT' bp p2 np) ;
  2379. bp = p2 ;
  2380. 'SI' ('<' &iplate nplate) ;
  2381. p2 = 'PLUS' bp (ec 0. 0.) ;
  2382. APPEND tablig 'LIG' ('DROIT' bp p2 nc) ;
  2383. bp = p2 ;
  2384. 'FINSI' ;
  2385. 'FIN' iplate ;
  2386. lcb = tablig . 'LIG' ;
  2387. p2 = 'PLUS' p0 bp ;
  2388. lch = 'DROIT' p1 p2 1 ;
  2389. bp = p2 ;
  2390. p3 = 'PLUS' bp (ef 0. 0.) ;
  2391. lcord = 'DROIT' nf p2 p3 ;
  2392. lcor = 'ET' lcorg lcord ;
  2393. *
  2394. * Part1 : bottom structure
  2395. *
  2396. bp = 0. 0. 0. ;
  2397. vt = 0. ef 0. ;
  2398. APPEND tabin 'STRUCTURE' ('TRANSLATION' (lcor 'ET' lcb) nf vt) ;
  2399. bp = 'PLUS' bp vt ;
  2400. *
  2401. * Loop on plates
  2402. *
  2403. 'REPETER' iplate nplate2 ;
  2404. * Structure part
  2405. vt = 0. ep 0. ;
  2406. lcort = 'PLUS' lcor bp ;
  2407. APPEND tabin 'STRUCTURE' ('TRANSLATION' lcort np vt) ;
  2408. * Fuel part
  2409. lcbt = 'PLUS' lcb bp ;
  2410. APPEND tabin 'FUEL' ('TRANSLATION' lcbt np vt) ;
  2411. lcbtt = 'PLUS' lcbt vt ;
  2412. 'SI' ('>' &iplate 1) ;
  2413. APPEND (tabin . 'INTERFACE') ('-' iitf 1) lcbt ;
  2414. 'FINSI' ;
  2415. APPEND (tabin . 'INTERFACE') iitf lcbtt ;
  2416. bp = 'PLUS' bp vt ;
  2417. 'SI' ('<' &iplate nplate2) ;
  2418. * Structure part
  2419. vt = 0. ec 0. ;
  2420. lcort = 'PLUS' lcor bp ;
  2421. p1t = 'PLUS' p1 bp ;
  2422. p1tt = 'PLUS' p1t vt ;
  2423. p2t = 'PLUS' p2 bp ;
  2424. p2tt = 'PLUS' p2t vt ;
  2425. APPEND tabin 'STRUCTURE' ('TRANSLATION' lcort nc vt) ;
  2426. APPEND (tabin . 'INTERFACE') iitf ('DROIT' p1t p1tt nc) ;
  2427. APPEND (tabin . 'INTERFACE') iitf ('DROIT' p2t p2tt nc) ;
  2428. * Channel part
  2429. lcht = 'PLUS' lch bp ;
  2430. APPEND (tabin . 'CHANNEL') iitf ('TRANSLATION' lcht 1 vt) ;
  2431. iitf = '+' iitf 1 ;
  2432. bp = 'PLUS' bp vt ;
  2433. * The last one is a half channel
  2434. 'SINON' ;
  2435. * Structure part
  2436. vt = 0. ec2 0. ;
  2437. lcort = 'PLUS' lcor bp ;
  2438. p1t = 'PLUS' p1 bp ;
  2439. p1tt = 'PLUS' p1t vt ;
  2440. p2t = 'PLUS' p2 bp ;
  2441. p2tt = 'PLUS' p2t vt ;
  2442. APPEND tabin 'STRUCTURE' ('TRANSLATION' lcort nc2 vt) ;
  2443. APPEND (tabin . 'INTERFACE') iitf ('DROIT' p1t p1tt nc2) ;
  2444. APPEND (tabin . 'INTERFACE') iitf ('DROIT' p2t p2tt nc2) ;
  2445. * Channel part
  2446. lcht = 'PLUS' lch bp ;
  2447. APPEND (tabin . 'CHANNEL') iitf ('TRANSLATION' lcht 1 vt) ;
  2448. iitf = '+' iitf 1 ;
  2449. 'FINSI' ;
  2450. 'FIN' iplate ;
  2451. *
  2452. 'RESPRO' tabin ;
  2453. *
  2454. * End of procedure file GEOMPL23
  2455. *
  2456. 'FINPROC' ;
  2457. *ENDPROCEDUR geompl23
  2458. *BEGINPROCEDUR geompla1
  2459. ************************************************************************
  2460. * NOM : GEOMPLA1
  2461. * DESCRIPTION : Mesh of a plate geometry : small symmetry cell
  2462. *
  2463. *
  2464. *
  2465. * LANGAGE : GIBIANE-CAST3M
  2466. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  2467. * mél : gounand@semt2.smts.cea.fr
  2468. **********************************************************************
  2469. * VERSION : v1, 22/11/2004, version initiale
  2470. * HISTORIQUE : v1, 22/11/2004, création
  2471. * HISTORIQUE :
  2472. * HISTORIQUE :
  2473. ************************************************************************
  2474. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  2475. * en cas de modification de ce sous-programme afin de faciliter
  2476. * la maintenance !
  2477. ************************************************************************
  2478. *
  2479. *
  2480. 'DEBPROC' GEOMPLA1 ;
  2481. 'ARGUMENT' Dh*'FLOTTANT' ;
  2482. 'ARGUMENT' ef*'FLOTTANT' ;
  2483. 'ARGUMENT' ep*'FLOTTANT' ;
  2484. 'ARGUMENT' nchan*'ENTIER' ;
  2485. *
  2486. 'SI' ('NEG' (MODULO nchan 2) 1) ;
  2487. cherr = 'CHAINE' 'nchan should be odd' ;
  2488. 'FINSI' ;
  2489. *
  2490. * Geometric quantities deduced from the one given above
  2491. *
  2492. ec = '/' Dh 2.D0 ;
  2493. ec2 = '/' ec 2 ;
  2494. nplate = '+' nchan 1 ;
  2495. L2 = '+' ('*' nplate ep) ('*' nchan ec) '+' ('*' ef 2) ;
  2496. L4 = '/' L2 2.D0 ;
  2497. *
  2498. * Discretisation
  2499. *
  2500. nplate2 = '/' nplate 2 ;
  2501. nc2 = 1 ;
  2502. nc = '*' nc2 2 ;
  2503. nf = 2 ;
  2504. np = 2 ;
  2505. *
  2506. * Tables
  2507. *
  2508. tabin1 = 'TABLE' ;
  2509. tabin1 . 'INTERFACE' = 'TABLE' ;
  2510. tabin1 . 'CHANNEL' = 'TABLE' ;
  2511. iitf = 1 ;
  2512. *
  2513. * Part1 : Lines
  2514. *
  2515. p0 = 0. 0. 0. ;
  2516. p1 = 0. ('*' ef -1.D0) 0. ;
  2517. lcor = 'DROIT' nf p0 p1 ;
  2518. tablig = 'TABLE' ;
  2519. bp = p1 ;
  2520. 'REPETER' ipl nplate2 ;
  2521. p2 = 'PLUS' bp (0. ('*' ep -1.D0) 0.) ;
  2522. APPEND tablig 'LIG' ('DROIT' bp p2 np) ;
  2523. bp = p2 ;
  2524. * The last one is an half channel
  2525. 'SI' ('NEG' &ipl nplate2) ;
  2526. p2 = 'PLUS' bp (0. ('*' ec -1.D0) 0.) ;
  2527. APPEND tablig 'LIG' ('DROIT' bp p2 nc) ;
  2528. bp = p2 ;
  2529. 'SINON' ;
  2530. p2 = 'PLUS' bp (0. ('*' ec2 -1.D0) 0.) ;
  2531. APPEND tablig 'LIG' ('DROIT' bp p2 nc2) ;
  2532. bp = p2 ;
  2533. 'FINSI' ;
  2534. 'FIN' ipl ;
  2535. lcb = tablig . 'LIG' ;
  2536. p2 = 'PLUS' p0 bp ;
  2537. lch = 'DROIT' p1 p2 1 ;
  2538. *
  2539. * Part1 : left structure
  2540. *
  2541. bp = 0. 0. 0. ;
  2542. vt = ef 0. 0. ;
  2543. APPEND tabin1 'STRUCTURE' ('TRANSLATION' (lcor 'ET' lcb) nf vt) ;
  2544. bp = 'PLUS' bp vt ;
  2545. *
  2546. * Loop on plates
  2547. *
  2548. 'REPETER' iplate nplate2 ;
  2549. * Structure part
  2550. vt = ep 0. 0. ;
  2551. lcort = 'PLUS' lcor bp ;
  2552. APPEND tabin1 'STRUCTURE' ('TRANSLATION' lcort np vt) ;
  2553. * Fuel part
  2554. lcbt = 'PLUS' lcb bp ;
  2555. APPEND tabin1 'FUEL' ('TRANSLATION' lcbt np vt) ;
  2556. lcbtt = 'PLUS' lcbt vt ;
  2557. 'SI' ('>' &iplate 1) ;
  2558. APPEND (tabin1 . 'INTERFACE') ('-' iitf 1) lcbt ;
  2559. 'FINSI' ;
  2560. APPEND (tabin1 . 'INTERFACE') iitf lcbtt ;
  2561. bp = 'PLUS' bp vt ;
  2562. 'SI' ('<' &iplate nplate2) ;
  2563. * Structure part
  2564. vt = ec 0. 0. ;
  2565. lcort = 'PLUS' lcor bp ;
  2566. p1t = 'PLUS' p1 bp ;
  2567. p2t = 'PLUS' p1t vt ;
  2568. APPEND tabin1 'STRUCTURE' ('TRANSLATION' lcort nc vt) ;
  2569. APPEND (tabin1 . 'INTERFACE') iitf ('DROIT' p1t p2t nc) ;
  2570. * Channel part
  2571. lcht = 'PLUS' lch bp ;
  2572. APPEND (tabin1 . 'CHANNEL') iitf ('TRANSLATION' lcht 1 vt) ;
  2573. iitf = '+' iitf 1 ;
  2574. bp = 'PLUS' bp vt ;
  2575. * The last one is a half channel
  2576. 'SINON' ;
  2577. * Structure part
  2578. vt = ec2 0. 0. ;
  2579. lcort = 'PLUS' lcor bp ;
  2580. p1t = 'PLUS' p1 bp ;
  2581. p2t = 'PLUS' p1t vt ;
  2582. APPEND tabin1 'STRUCTURE' ('TRANSLATION' lcort nc2 vt) ;
  2583. APPEND (tabin1 . 'INTERFACE') iitf ('DROIT' p1t p2t nc2) ;
  2584. * Channel part
  2585. lcht = 'PLUS' lch bp ;
  2586. APPEND (tabin1 . 'CHANNEL') iitf ('TRANSLATION' lcht 1 vt) ;
  2587. iitf = '+' iitf 1 ;
  2588. 'FINSI' ;
  2589. 'FIN' iplate ;
  2590. nitf = ('-' iitf 1) ;
  2591. *
  2592. * Perform rotations
  2593. *
  2594. tabin = 'TABLE' ;
  2595. tabin . 'INTERFACE' = 'TABLE' ;
  2596. tabin . 'CHANNEL' = 'TABLE' ;
  2597. iitf = 1 ;
  2598. pr = 0. 0. 1. ;
  2599. 'REPETER' bclrot 4 ;
  2600. arot = '*' 90. ('-' &bclrot 1) ;
  2601. append tabin 'STRUCTURE'
  2602. ('TOURNER' (tabin1 . 'STRUCTURE') arot p0 pr) ;
  2603. append tabin 'FUEL'
  2604. ('TOURNER' (tabin1 . 'FUEL') arot p0 pr) ;
  2605. 'REPETER' bitf nitf ;
  2606. append (tabin . 'INTERFACE') iitf
  2607. ('TOURNER' (tabin1 . 'INTERFACE' . &bitf) arot p0 pr) ;
  2608. append (tabin . 'CHANNEL') iitf
  2609. ('TOURNER' (tabin1 . 'CHANNEL' . &bitf) arot p0 pr) ;
  2610. iitf = '+' iitf 1 ;
  2611. 'FIN' bitf ;
  2612. 'FIN' bclrot ;
  2613. *
  2614. 'RESPRO' tabin ;
  2615. *
  2616. * End of procedure file GEOMPLA1
  2617. *
  2618. 'FINPROC' ;
  2619. *ENDPROCEDUR geompla1
  2620. *BEGINPROCEDUR geompla2
  2621. ************************************************************************
  2622. * NOM : GEOMPLA2
  2623. * DESCRIPTION : Mesh of a plate geometry
  2624. *
  2625. *
  2626. *
  2627. * LANGAGE : GIBIANE-CAST3M
  2628. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  2629. * mél : gounand@semt2.smts.cea.fr
  2630. **********************************************************************
  2631. * VERSION : v1, 22/11/2004, version initiale
  2632. * HISTORIQUE : v1, 22/11/2004, création
  2633. * HISTORIQUE :
  2634. * HISTORIQUE :
  2635. ************************************************************************
  2636. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  2637. * en cas de modification de ce sous-programme afin de faciliter
  2638. * la maintenance !
  2639. ************************************************************************
  2640. *
  2641. *
  2642. 'DEBPROC' GEOMPLA2 ;
  2643. 'ARGUMENT' Dh*'FLOTTANT' ;
  2644. 'ARGUMENT' ef*'FLOTTANT' ;
  2645. 'ARGUMENT' ep*'FLOTTANT' ;
  2646. 'ARGUMENT' nchan*'ENTIER' ;
  2647. *
  2648. 'SI' ('NEG' (MODULO nchan 2) 1) ;
  2649. cherr = 'CHAINE' 'nchan should be odd' ;
  2650. 'FINSI' ;
  2651. *
  2652. * Geometric quantities deduced from the one given above
  2653. *
  2654. ec = '/' Dh 2.D0 ;
  2655. ec2 = '/' ec 2 ;
  2656. nplate = '+' nchan 1 ;
  2657. L2 = '+' ('*' nplate ep) ('*' nchan ec) '+' ('*' ef 2) ;
  2658. mL2 = '*' L2 -1.D0 ;
  2659. L4 = '/' L2 2.D0 ;
  2660. *
  2661. * Discretization
  2662. *
  2663. nc2 = 1 ;
  2664. nf = 2 ;
  2665. np = 2 ;
  2666. *
  2667. * Type 1 cells
  2668. *
  2669. tabin1 = GEOMPL21 Dh ef ep nchan nc2 nf np ;
  2670. *
  2671. * Type 2 cells
  2672. *
  2673. tabin2 = GEOMPL22 Dh ef ep nchan nc2 nf np ;
  2674. *
  2675. * Type 3 cells
  2676. *
  2677. tabin3 = GEOMPL23 Dh ef ep nchan nc2 nf np ;
  2678. *
  2679. * Perform rotations and translations to generate total mesh
  2680. *
  2681. tabin = 'TABLE' ;
  2682. tabin . 'INTERFACE' = 'TABLE' ;
  2683. tabin . 'CHANNEL' = 'TABLE' ;
  2684. iitf = 1 ;
  2685. *
  2686. * part1 : Type 1 cells
  2687. *
  2688. nitf = 'DIME' (tabin1 . 'INTERFACE') ;
  2689. append tabin 'STRUCTURE' (tabin1 . 'STRUCTURE') ;
  2690. append tabin 'FUEL' (tabin1 . 'FUEL') ;
  2691. 'REPETER' bitf nitf ;
  2692. append (tabin . 'INTERFACE') iitf
  2693. (tabin1 . 'INTERFACE' . &bitf) ;
  2694. append (tabin . 'CHANNEL') iitf
  2695. (tabin1 . 'CHANNEL' . &bitf) ;
  2696. iitf = '+' iitf 1 ;
  2697. 'FIN' bitf ;
  2698. *
  2699. * part2 : two Type2 cells
  2700. *
  2701. 'REPETER' btype2 2 ;
  2702. 'SI' ('EGA' &btype2 1) ;
  2703. arot = 90.D0 ;
  2704. vtra = (L2 0.D0 0.D0) ;
  2705. lsym = VRAI ;
  2706. 'FINSI' ;
  2707. 'SI' ('EGA' &btype2 2) ;
  2708. arot = 180.D0 ;
  2709. vtra = (L2 0.D0 0.D0) ;
  2710. lsym = VRAI ;
  2711. 'FINSI' ;
  2712. nitf = 'DIME' (tabin2 . 'INTERFACE') ;
  2713. append tabin 'STRUCTURE'
  2714. (SYTOPL (tabin2 . 'STRUCTURE') arot vtra lsym) ;
  2715. append tabin 'FUEL'
  2716. (SYTOPL (tabin2 . 'FUEL') arot vtra lsym) ;
  2717. 'REPETER' bitf nitf ;
  2718. append (tabin . 'INTERFACE') iitf
  2719. (SYTOPL (tabin2 . 'INTERFACE' . &bitf) arot vtra lsym) ;
  2720. append (tabin . 'CHANNEL') iitf
  2721. (SYTOPL (tabin2 . 'CHANNEL' . &bitf) arot vtra lsym) ;
  2722. iitf = '+' iitf 1 ;
  2723. 'FIN' bitf ;
  2724. 'FIN' btype2 ;
  2725. *
  2726. * part3 : Type 1 cells
  2727. *
  2728. nitf = 'DIME' (tabin3 . 'INTERFACE') ;
  2729. append tabin 'STRUCTURE' (tabin3 . 'STRUCTURE') ;
  2730. append tabin 'FUEL' (tabin3 . 'FUEL') ;
  2731. 'REPETER' bitf nitf ;
  2732. append (tabin . 'INTERFACE') iitf
  2733. (tabin3 . 'INTERFACE' . &bitf) ;
  2734. append (tabin . 'CHANNEL') iitf
  2735. (tabin3 . 'CHANNEL' . &bitf) ;
  2736. iitf = '+' iitf 1 ;
  2737. 'FIN' bitf ;
  2738. *
  2739. * part4 : two Type2 cells
  2740. *
  2741. 'REPETER' btype2 2 ;
  2742. 'SI' ('EGA' &btype2 1) ;
  2743. arot = 180.D0 ;
  2744. vtra = (0.D0 0.D0 0.D0) ;
  2745. lsym = FAUX ;
  2746. 'FINSI' ;
  2747. 'SI' ('EGA' &btype2 2) ;
  2748. arot = 270.D0 ;
  2749. vtra = (0.D0 0.D0 0.D0) ;
  2750. lsym = FAUX ;
  2751. 'FINSI' ;
  2752. nitf = 'DIME' (tabin2 . 'INTERFACE') ;
  2753. append tabin 'STRUCTURE'
  2754. (SYTOPL (tabin2 . 'STRUCTURE') arot vtra lsym) ;
  2755. append tabin 'FUEL'
  2756. (SYTOPL (tabin2 . 'FUEL') arot vtra lsym) ;
  2757. 'REPETER' bitf nitf ;
  2758. append (tabin . 'INTERFACE') iitf
  2759. (SYTOPL (tabin2 . 'INTERFACE' . &bitf) arot vtra lsym) ;
  2760. append (tabin . 'CHANNEL') iitf
  2761. (SYTOPL (tabin2 . 'CHANNEL' . &bitf) arot vtra lsym) ;
  2762. iitf = '+' iitf 1 ;
  2763. 'FIN' bitf ;
  2764. 'FIN' btype2 ;
  2765. *
  2766. 'RESPRO' tabin ;
  2767. *
  2768. * End of procedure file GEOMPLA2
  2769. *
  2770. 'FINPROC' ;
  2771. *ENDPROCEDUR geompla2
  2772. *BEGINPROCEDUR geomplh1
  2773. ************************************************************************
  2774. * NOM : GEOMPLH1
  2775. * DESCRIPTION : Géométrie hexagonale à plaques
  2776. * Technical report DM2S/SFME/LTMF/RT/05-050/A
  2777. * typgeo = 1 small losange cell
  2778. * typgeo = 2 normal hexagonal cell
  2779. * typgeo = 3 large two hexagonal cells
  2780. *
  2781. *
  2782. * LANGAGE : GIBIANE-CAST3M
  2783. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  2784. * mél : gounand@semt2.smts.cea.fr
  2785. **********************************************************************
  2786. * VERSION : v1, 21/03/2005, version initiale
  2787. * HISTORIQUE : v1, 21/03/2005, création
  2788. * HISTORIQUE :
  2789. * HISTORIQUE :
  2790. ************************************************************************
  2791. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  2792. * en cas de modification de ce sous-programme afin de faciliter
  2793. * la maintenance !
  2794. ************************************************************************
  2795. *
  2796. *
  2797. 'DEBPROC' GEOMPLH1 ;
  2798. 'ARGUMENT' ept*'FLOTTANT' ;
  2799. 'ARGUMENT' eps*'FLOTTANT' ;
  2800. 'ARGUMENT' epp*'FLOTTANT' ;
  2801. 'ARGUMENT' epg*'FLOTTANT' ;
  2802. 'ARGUMENT' npp*'ENTIER' ;
  2803. 'ARGUMENT' typgeo*'ENTIER' ;
  2804. *
  2805. * On commence par projeter toutes les quantités sur une génératrice
  2806. *
  2807. ff = '/' 2.D0 ('**' 3.D0 0.5D0) ;
  2808. l = '*' ('/' ept 2.D0) ff ;
  2809. eps = '*' eps ff ;
  2810. epp = '*' epp ff ;
  2811. epg = '*' epg ff ;
  2812. eps2 = '/' eps 2.D0 ;
  2813. *
  2814. res = '-' l (eps2 '+' ('*' epp npp) '+' ('*' epg ('-' npp 1))
  2815. '+' eps) ;
  2816. epg2 = '/' res 2.D0 ;
  2817. *
  2818. * Discrétisation
  2819. *
  2820. ns2 = 1 ;
  2821. *ns2 = 2 ;
  2822. ns = '*' ns2 2 ;
  2823. ng = 2 ;
  2824. ng2 = 'ENTIER' ('+' ('*' ng ('/' epg2 epg)) 0.5D0) ;
  2825. *'MESSAGE' ('CHAINE' 'ng2 = ' ng2) ;
  2826. *'MESSAGE' ('CHAINE' 'epg = ' epg) ;
  2827. *'MESSAGE' ('CHAINE' 'epg2 = ' epg2) ;
  2828. *'MESSAGE' ('CHAINE' 'epg '-' epg2 = ' ('-' epg epg2)) ;
  2829. *ng2 = 1 ;
  2830. *ng2 = 2 ;
  2831. np = 3 ;
  2832. *ns2 = 3 ;
  2833. *ns = 3 ;
  2834. *ng = 3 ;
  2835. *ng2 = 3 ;
  2836. *np = 3 ;
  2837. *
  2838. * Build the horizontal generator
  2839. *
  2840. itg = 0 ;
  2841. tabgen = 'TABLE' ;
  2842. bp = 0.D0 0.D0 0.D0 ;
  2843. * left structure
  2844. bpp = 'PLUS' bp (eps2 0. 0.) ;
  2845. ss = 'DROIT' bp ns2 bpp ;
  2846. bp = bpp ;
  2847. itg = '+' itg 1 ;
  2848. tabgen . itg = 'TABLE' ;
  2849. tabgen . itg . 'TYPE' = 'CHAINE' 'ST' ;
  2850. tabgen . itg . 'SEG' = ss ;
  2851. * left gas channel
  2852. bpp = 'PLUS' bp (epg2 0. 0.) ;
  2853. ss = 'DROIT' bp ng2 bpp ;
  2854. bp = bpp ;
  2855. itg = '+' itg 1 ;
  2856. tabgen . itg = 'TABLE' ;
  2857. tabgen . itg . 'TYPE' = 'CHAINE' 'CH' ;
  2858. tabgen . itg . 'SEG' = ss ;
  2859. * plates and channel
  2860. 'REPETER' ipp npp ;
  2861. bpp = 'PLUS' bp (epp 0. 0.) ;
  2862. ss = 'DROIT' bp np bpp ;
  2863. bp = bpp ;
  2864. itg = '+' itg 1 ;
  2865. tabgen . itg = 'TABLE' ;
  2866. tabgen . itg . 'TYPE' = 'CHAINE' 'FU' ;
  2867. tabgen . itg . 'SEG' = ss ;
  2868. 'SI' ('NEG' &ipp npp) ;
  2869. bpp = 'PLUS' bp (epg 0. 0.) ;
  2870. ss = 'DROIT' bp ng bpp ;
  2871. bp = bpp ;
  2872. itg = '+' itg 1 ;
  2873. tabgen . itg = 'TABLE' ;
  2874. tabgen . itg . 'TYPE' = 'CHAINE' 'CH' ;
  2875. tabgen . itg . 'SEG' = ss ;
  2876. 'FINSI' ;
  2877. 'FIN' ipp ;
  2878. *
  2879. * right gas channel
  2880. bpp = 'PLUS' bp (epg2 0. 0.) ;
  2881. ss = 'DROIT' bp ng2 bpp ;
  2882. bp = bpp ;
  2883. itg = '+' itg 1 ;
  2884. tabgen . itg = 'TABLE' ;
  2885. tabgen . itg . 'TYPE' = 'CHAINE' 'CH' ;
  2886. tabgen . itg . 'SEG' = ss ;
  2887. * right structure
  2888. bpp = 'PLUS' bp (eps 0. 0.) ;
  2889. ss = 'DROIT' bp ns bpp ;
  2890. bp = bpp ;
  2891. itg = '+' itg 1 ;
  2892. tabgen . itg = 'TABLE' ;
  2893. tabgen . itg . 'TYPE' = 'CHAINE' 'ST' ;
  2894. tabgen . itg . 'SEG' = ss ;
  2895. *
  2896. * Build the vertical generators
  2897. *
  2898. prot1 = 0.D0 0.D0 0.D0 ;
  2899. prot2 = 0.D0 0.D0 1.D0 ;
  2900. arot = 120.D0 ;
  2901. tabtmp = 'TABLE' ;
  2902. 'REPETER' iitg ('DIME' tabgen) ;
  2903. titg = tabgen . &iitg ;
  2904. 'SI' ('EGA' (titg . 'TYPE') 'ST') ;
  2905. APPEND tabtmp 'GENSTR' (titg . 'SEG') ;
  2906. 'SINON' ;
  2907. APPEND tabtmp 'GENFU' (titg . 'SEG') ;
  2908. 'FINSI' ;
  2909. 'FIN' iitg ;
  2910. genstr = tabtmp . 'GENSTR' ;
  2911. genfu = tabtmp . 'GENFU' ;
  2912. *
  2913. genstr = 'TOURNER' genstr arot prot1 prot2 ;
  2914. genfu = 'TOURNER' genfu arot prot1 prot2 ;
  2915. gench = 'DROIT' ('POIN' genfu 'INITIAL') 1 ('POIN' genfu 'FINAL') ;
  2916. *gent = 'ET' (tabtmp . 'GENSTR') (tabtmp . 'GENFU') ;
  2917. *'LISTE' genstr ;
  2918. *'LISTE' genfu ;
  2919. *'LISTE' gent ;
  2920. *strgen = 'COULEUR' (genstr 'GENERATRICE' gent) 'BLAN' ;
  2921. *fugen = 'COULEUR' (genfu 'GENERATRICE' gent) 'ROUG' ;
  2922. *'OPTION' 'DIME' 2 ;
  2923. *'TRACER' ('ET' genstr ('COULEUR' gent 'ROUG')) ;
  2924. *'TRACER' fugen ;
  2925. *'TRACER' (fugen 'ET' strgen) ;
  2926. *
  2927. * Construire une cellule élémentaire dans tabin1
  2928. *
  2929. tabin1 = 'TABLE' ;
  2930. tabin1 . 'INTERFACE' = 'TABLE' ;
  2931. tabin1 . 'CHANNEL' = 'TABLE' ;
  2932. tabin1 . 'DH' = 'TABLE' ;
  2933. ich = 0 ;
  2934. bp = 0. 0. 0. ;
  2935. 'REPETER' iitg ('DIME' tabgen) ;
  2936. titg = tabgen . &iitg ;
  2937. 'SI' ('EGA' (titg . 'TYPE') 'ST') ;
  2938. li = titg . 'SEG' ;
  2939. su = ('PLUS' ('ET' genstr genfu) bp) 'GENERATRICE' li ;
  2940. APPEND tabin1 'STRUCTURE' su ;
  2941. bp = 'POIN' li 'FINAL' ;
  2942. 'FINSI' ;
  2943. 'SI' ('EGA' (titg . 'TYPE') 'CH') ;
  2944. li = titg . 'SEG' ;
  2945. ct = 'CONTOUR' (('PLUS' genfu bp) 'GENERATRICE' li) ;
  2946. dh = '/' ('*' ('MESURE' ct 'SURF') 4.D0) ('MESURE' ct) ;
  2947. * 'MESSAGE' ('CHAINE' 'Dh = ' dh) ;
  2948. li2 = 'DROIT' ('POIN' li 'INITIAL') 1 ('POIN' li 'FINAL') ;
  2949. su = ('PLUS' gench bp) 'GENERATRICE' li2 ;
  2950. ich = '+' ich 1 ;
  2951. APPEND (tabin1 . 'INTERFACE') ich ct ;
  2952. APPEND (tabin1 . 'CHANNEL') ich su ;
  2953. tabin1 . 'DH' . ich = dh ;
  2954. su = ('PLUS' genstr bp) 'GENERATRICE' li ;
  2955. APPEND tabin1 'STRUCTURE' su ;
  2956. bp = 'POIN' li 'FINAL' ;
  2957. 'FINSI' ;
  2958. 'SI' ('EGA' (titg . 'TYPE') 'FU') ;
  2959. li = titg . 'SEG' ;
  2960. su = ('PLUS' genfu bp) 'GENERATRICE' li ;
  2961. APPEND tabin1 'FUEL' su ;
  2962. su = ('PLUS' genstr bp) 'GENERATRICE' li ;
  2963. APPEND tabin1 'STRUCTURE' su ;
  2964. bp = 'POIN' li 'FINAL' ;
  2965. 'FINSI' ;
  2966. 'FIN' iitg ;
  2967. *
  2968. * Construire un bloc de trois cellules
  2969. *
  2970. tabin2 = 'TABLE' ;
  2971. tabin2 . 'INTERFACE' = 'TABLE' ;
  2972. tabin2 . 'CHANNEL' = 'TABLE' ;
  2973. tabin2 . 'DH' = 'TABLE' ;
  2974. iitf = 0 ;
  2975. p0 = 0. 0. 0. ;
  2976. pr = 0. 0. 1. ;
  2977. 'REPETER' bclrot 3 ;
  2978. arot = '*' 120.D0 ('-' &bclrot 1) ;
  2979. append tabin2 'STRUCTURE'
  2980. ('TOURNER' (tabin1 . 'STRUCTURE') arot p0 pr) ;
  2981. append tabin2 'FUEL'
  2982. ('TOURNER' (tabin1 . 'FUEL') arot p0 pr) ;
  2983. 'REPETER' bich ich ;
  2984. iitf = '+' iitf 1 ;
  2985. append (tabin2 . 'INTERFACE') iitf
  2986. ('TOURNER' (tabin1 . 'INTERFACE' . &bich) arot p0 pr) ;
  2987. append (tabin2 . 'CHANNEL') iitf
  2988. ('TOURNER' (tabin1 . 'CHANNEL' . &bich) arot p0 pr) ;
  2989. tabin2 . 'DH' . iitf = tabin1 . 'DH' . &bich ;
  2990. '