Télécharger defila.dgibi

Retour à la liste

Numérotation des lignes :

  1. * fichier : defila.dgibi
  2. ************************************************************************
  3. ************************************************************************
  4. *
  5. 'OPTI' 'ECHO' 1 ;
  6. *
  7. 'SAUTER' 2 'LIGNE' ;
  8. 'MESSAGE' ' Execution de defila.dgibi' ;
  9. 'SAUTER' 2 'LIGNE' ;
  10. *
  11. graph = faux ;
  12. complet = faux ;
  13. interact = faux ;
  14. *
  15. ************************************************************************
  16. * NOM : DEFILA
  17. * DESCRIPTION : Ecoulement sous une surface libre soumise à une pression
  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, 21/06/2010, version initiale
  24. * HISTORIQUE : v1, 21/06/2010, 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. 'OPTION' 'DIME' 2 'MODE' 'PLAN' 'ISOV' 'SURF' 'ELEM' 'QUA4' ;
  34. * 'OPTION' 'DIME' 3 'MODE' 'TRID' 'ISOV' 'SURF' 'ELEM' 'CUB8' ;
  35. 'SI' ('NON' interact) ;
  36. 'OPTI' 'TRACER' 'PS' ;
  37. 'SINON' ;
  38. 'OPTI' 'TRACER' 'X' ;
  39. 'FINSI' ;
  40. debug = faux ;
  41. dbggra1 = faux ;
  42. dbggra2 = faux ;
  43. *
  44. *fic = 'CHAINE' '/test4/gounand/kong/defilad2h3q60r2it24.sauv' ;
  45. *'MESSAGE' ('CHAINE' 'Loading ' fic '...') ;
  46. *'OPTI' 'RESTITUER' fic ;
  47. *'RESTITUER' ;
  48. *
  49. ************************************************************************
  50. *
  51. *
  52. * PROCEDURES
  53. *
  54. *
  55. ************************************************************************
  56. 'DEBPROC' attente ;
  57. 'ARGUMENT' s*'FLOTTANT' ;
  58. 'SI' interact ;
  59. 'REPETER' i ('+' ('ENTIER' ('*' 100000 s)) 1) ;
  60. 'FIN' i ;
  61. 'FINSI' ;
  62. 'FINPROC' ;
  63. *BEGINPROCEDUR affvar
  64. ************************************************************************
  65. * NOM : AFFVAR
  66. * DESCRIPTION : Affiche des variables
  67. *
  68. *
  69. *
  70. * LANGAGE : GIBIANE-CAST3M
  71. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  72. * mél : gounand@semt2.smts.cea.fr
  73. **********************************************************************
  74. *
  75. *
  76. 'DEBPROC' AFFVAR ;
  77. 'REPETER' bcl ;
  78. 'ARGUMENT' x/'FLOTTANT' ;
  79. 'SI' ('EXISTE' x) ;
  80. 'ARGUMENT' lx*'MOT' ;
  81. 'MESSAGE' ('CHAINE' lx '=' x) ;
  82. 'SINON' ;
  83. 'QUITTER' bcl ;
  84. 'FINSI' ;
  85. 'FIN' bcl ;
  86. 'FINPROC' ;
  87. *
  88. * End of procedure file AFFVAR
  89. *
  90. *ENDPROCEDUR affvar
  91. *BEGINPROCEDUR append
  92. ************************************************************************
  93. * NOM : APPEND
  94. * DESCRIPTION : Rajoute :
  95. * - un entier à un listentier
  96. * - un réel à un listreel
  97. * - un objet (liste, evolution, matrice ou chpoint)
  98. * à un indice de table ('MOT' ou 'ENTIER')
  99. * * si l'indice n'existe pas
  100. * * 'ET' si l'indice existe
  101. *
  102. *
  103. *
  104. * LANGAGE : GIBIANE-CAST3M
  105. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  106. * mél : gounand@semt2.smts.cea.fr
  107. **********************************************************************
  108. * VERSION : v1, 10/09/2004, version initiale
  109. * HISTORIQUE : v1, 10/09/2004, création
  110. * HISTORIQUE :
  111. * HISTORIQUE :
  112. ************************************************************************
  113. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  114. * en cas de modification de ce sous-programme afin de faciliter
  115. * la maintenance !
  116. ************************************************************************
  117. *
  118. *
  119. 'DEBPROC' APPEND ;
  120. 'ARGUMENT' tab/'TABLE' ;
  121. 'SI' ('EXISTE' tab) ;
  122. 'ARGUMENT' itab/'MOT' ;
  123. 'SI' ('NON' ('EXISTE' itab)) ;
  124. 'ARGUMENT' itab*'ENTIER' ;
  125. 'FINSI' ;
  126. lobj = FAUX ;
  127. 'SI' ('NON' lobj) ;
  128. 'ARGUMENT' lr/'LISTREEL' ;
  129. 'SI' ('EXISTE' lr) ;
  130. obj = lr ; lobj = VRAI ;
  131. 'FINSI' ;
  132. 'FINSI' ;
  133. 'SI' ('NON' lobj) ;
  134. 'ARGUMENT' le/'LISTENTI' ;
  135. 'SI' ('EXISTE' le) ;
  136. obj = le ; lobj = VRAI ;
  137. 'FINSI' ;
  138. 'FINSI' ;
  139. 'SI' ('NON' lobj) ;
  140. 'ARGUMENT' lev/'EVOLUTION' ;
  141. 'SI' ('EXISTE' lev) ;
  142. obj = lev ; lobj = VRAI ;
  143. 'FINSI' ;
  144. 'FINSI' ;
  145. 'SI' ('NON' lobj) ;
  146. 'ARGUMENT' lm/'MAILLAGE' ;
  147. 'SI' ('EXISTE' lm) ;
  148. obj = lm ; lobj = VRAI ;
  149. 'FINSI' ;
  150. 'FINSI' ;
  151. 'SI' ('NON' lobj) ;
  152. 'ARGUMENT' chpo/'CHPOINT' ;
  153. 'SI' ('EXISTE' chpo) ;
  154. obj = chpo ; lobj = VRAI ;
  155. 'FINSI' ;
  156. 'FINSI' ;
  157. 'SI' ('NON' lobj) ;
  158. 'ARGUMENT' rig/'RIGIDITE' ;
  159. 'SI' ('EXISTE' rig) ;
  160. obj = rig ; lobj = VRAI ;
  161. 'FINSI' ;
  162. 'FINSI' ;
  163. 'SI' ('NON' lobj) ;
  164. 'ARGUMENT' matk/'MATRIK' ;
  165. 'SI' ('EXISTE' matk) ;
  166. obj = matk ; lobj = VRAI ;
  167. 'FINSI' ;
  168. 'FINSI' ;
  169. 'SI' ('NON' lobj) ;
  170. cherr = 'CHAINE'
  171. 'Il faut fournir un objet liste, evolution, matrice ou chpoint.'
  172. ;
  173. 'ERREUR' cherr ;
  174. 'FINSI' ;
  175. 'SI' ('EXISTE' tab itab) ;
  176. 'SI' ('EGA' ('TYPE' obj) 'CHPOINT') ;
  177. tab . itab = '+' (tab . itab) obj ;
  178. 'SINON' ;
  179. tab . itab = 'ET' (tab . itab) obj ;
  180. 'FINSI' ;
  181. 'SINON' ;
  182. tab . itab = obj ;
  183. 'FINSI' ;
  184. 'RESPRO' tab ;
  185. 'FINSI' ;
  186. 'ARGUMENT' lenti/'LISTENTI' ;
  187. 'ARGUMENT' lreel/'LISTREEL' ;
  188. 'SI' ('EXISTE' lenti) ;
  189. 'ARGUMENT' enti*'ENTIER' ;
  190. lenti = 'ET' lenti ('LECT' enti) ;
  191. 'RESPRO' lenti ;
  192. 'FINSI' ;
  193. 'SI' ('EXISTE' lreel) ;
  194. 'ARGUMENT' reel*'FLOTTANT' ;
  195. lreel = 'ET' lreel ('PROG' reel) ;
  196. 'RESPRO' lreel ;
  197. 'FINSI' ;
  198. *
  199. * End of procedure file APPEND
  200. *
  201. 'FINPROC' ;
  202. *ENDPROCEDUR append
  203. *BEGINPROCEDUR calimet
  204. ************************************************************************
  205. * NOM : CALIMET
  206. * DESCRIPTION :
  207. *
  208. *
  209. *
  210. * LANGAGE : GIBIANE-CAST3M
  211. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  212. * mél : gounand@semt2.smts.cea.fr
  213. **********************************************************************
  214. * VERSION : v1, ??/??/2007, version initiale
  215. * HISTORIQUE : v1, ??/??/2007, création
  216. * HISTORIQUE :
  217. * HISTORIQUE :
  218. ************************************************************************
  219. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  220. * en cas de modification de ce sous-programme afin de faciliter
  221. * la maintenance !
  222. ************************************************************************
  223. *
  224. *
  225. 'DEBPROC' CALIMET ;
  226. 'ARGUMENT' _mt*'MAILLAGE' ;
  227. 'ARGUMENT' gdisc*'MOT' ;
  228. 'ARGUMENT' methgau*'MOT' ;
  229. *methgau = 'GAU7' ;
  230. tmot = 'TABLE' ;
  231. tnom = 'TABLE' ;
  232. idim = 'VALEUR' 'DIME' ;
  233. vdim = DEADUTIL 'DIMM' _mt ;
  234. idx = 0 ;
  235. cim = 'CHAINE' 'IMET' ;
  236. cg = 'CHAINE' 'G' ;
  237. 'REPETER' iidim idim ;
  238. 'REPETER' jidim idim ;
  239. 'SI' ('>EG' &jidim &iidim) ;
  240. idx = '+' idx 1 ;
  241. tmot . idx = 'CHAINE' cim &iidim &jidim ;
  242. * Convention Castem opposee à convention NLIN
  243. tnom . idx = 'CHAINE' cg &jidim &iidim ;
  244. 'FINSI' ;
  245. 'FIN' jidim ;
  246. 'FIN' iidim ;
  247. *
  248. lvid = 'LECT' ;
  249. dtm = 'DIME' tmot ;
  250. tchpo = 'TABLE' 'ESCLAVE' ;
  251. idx = 0 ;
  252. 'REPETER' itm dtm ;
  253. mcm = tmot . &itm ;
  254. numop = 1 ;
  255. numder = vdim ;
  256. numvar = 1 ;
  257. numdat = 0 ;
  258. numcof = 1 ;
  259. A = ININLIN numop numvar numdat numcof numder ;
  260. A . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
  261. A . 'VAR' . 1 . 'DISC' = 'CSTE' ;
  262. A . 'VAR' . 1 . 'VALEUR' = 1. ;
  263. A . 'COF' . 1 . 'COMPOR' = mcm ;
  264. A . 'COF' . 1 . 'LDAT' = lvid ;
  265. A . 1 . 1 . 0 = 'LECT' 1 ;
  266. numdat = 0 ;
  267. numcof = 0 ;
  268. B = ININLIN numop numvar numdat numcof numder ;
  269. B . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
  270. B . 'VAR' . 1 . 'DISC' = 'CSTE' ;
  271. B . 'VAR' . 1 . 'VALEUR' = 1. ;
  272. B . 1 . 1 . 0 = lvid ;
  273. cpo = NLIN gdisc _mt A B 'ERF1' methgau ;
  274. cpo = 'NOMC' (tnom . &itm) cpo ;
  275. idx = '+' idx 1 ;
  276. tchpo . idx = cpo ;
  277. 'FIN' itm ;
  278. imet = 'ET' tchpo ;
  279. 'RESPRO' imet ;
  280. *
  281. * End of procedure file CALIMET
  282. *
  283. 'FINPROC' ;
  284. *ENDPROCEDUR calimet
  285. *BEGINPROCEDUR defdd
  286. ************************************************************************
  287. * NOM : DEFDD
  288. * DESCRIPTION :
  289. *
  290. *
  291. *
  292. * LANGAGE : GIBIANE-CAST3M
  293. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  294. * mél : gounand@semt2.smts.cea.fr
  295. **********************************************************************
  296. * VERSION : v1, ??/??/2007, version initiale
  297. * HISTORIQUE : v1, ??/??/2007, création
  298. * HISTORIQUE :
  299. * HISTORIQUE :
  300. ************************************************************************
  301. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  302. * en cas de modification de ce sous-programme afin de faciliter
  303. * la maintenance !
  304. ************************************************************************
  305. *
  306. *
  307. 'DEBPROC' DEFDD ;
  308. *'ARGUMENT' _cmt*'MAILLAGE' ;
  309. *'ARGUMENT' cmt*'MAILLAGE' ;
  310. *'ARGUMENT' sur*'MAILLAGE' ;
  311. 'ARGUMENT' tdisc*'TABLE' ;
  312. 'ARGUMENT' idir/'ENTIER' ;
  313. 'SI' ('NON' ('EXISTE' idir)) ;
  314. idir = 0 ;
  315. 'FINSI' ;
  316. *
  317. NOMDEP = @STBL (TDISC . 'XN' . 'NOMINC') ;
  318. *
  319. vdim = 'VALEUR' 'DIME' ;
  320. DISCG = TDISC . 'GEOM' . 'DISC' ;
  321. _hau = tdisc . 'hau' . 'QUAF' ;
  322. hau = tdisc . 'hau' . discg ;
  323. vnor = GNOR _hau tdisc 'NPRI' discg 'FPRI' 1. 'NDUA' 'XN' ;
  324. * 'SI' ('EGA' vdim 3) ;
  325. * vnor = '*' vnor -1. ;
  326. * 'FINSI' ;
  327. vnorn = '/' vnor ('**' ('PSCAL' vnor vnor nomdep nomdep) 0.5 ) ;
  328. * trvec hau vnorn 'Vnorn' ;
  329. * Correction de vnorn aux extrémités
  330. phau = 'CHANGER' 'POI1' hau ;
  331. 'SI' ('EGA' idir 0) ;
  332. 'SI' ('EGA' vdim 2) ;
  333. mcorr = ('POIN' hau 'INITIAL')
  334. 'ET' ('POIN' hau 'FINAL') ;
  335. 'SINON' ;
  336. bhau = tdisc . 'bhau' . discg ;
  337. * mcorr = 'CONTOUR' sur ;
  338. *---------------pour 3D
  339. mcorr = bhau ;
  340. * 'TRACER' (hau 'ET' ('COULEUR' bhau roug)) ;
  341. 'FINSI' ;
  342. 'SINON' ;
  343. mcorr = hau ;
  344. 'FINSI' ;
  345. pmcorr = 'CHANGER' 'POI1' mcorr ;
  346. phaur = 'DIFF' phau pmcorr ;
  347. vnorn1 = 'REDU' vnorn phaur ;
  348. vvn = 'PROG' vdim * 0. ;
  349. 'REMPLACER' vvn vdim 1. ;
  350. * vnorn2 = 'MANUEL' 'CHPO' mcorr 2 'UX' 0. 'UY' 1. ;
  351. * 'LISTE' nomdep ;
  352. * 'LISTE' vvn ;
  353. vnorn2 = 'MANUEL' 'CHPO' mcorr nomdep vvn ;
  354. vnorn = vnorn1 '+' vnorn2 ;
  355. * trvec hau vnorn 'Vnorn2' ;
  356. 'RESPRO' vnorn ;
  357. 'FINPROC' ;
  358. *
  359. * End of procedure file DEFDD
  360. *
  361. *ENDPROCEDUR defdd
  362. *BEGINPROCEDUR defdfors
  363. ************************************************************************
  364. * NOM : DEFDFORS
  365. * DESCRIPTION :
  366. *
  367. *
  368. *
  369. * LANGAGE : GIBIANE-CAST3M
  370. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  371. * mél : gounand@semt2.smts.cea.fr
  372. **********************************************************************
  373. * VERSION : v1, ??/??/2007, version initiale
  374. * HISTORIQUE : v1, ??/??/2007, création
  375. * HISTORIQUE :
  376. * HISTORIQUE :
  377. ************************************************************************
  378. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  379. * en cas de modification de ce sous-programme afin de faciliter
  380. * la maintenance !
  381. ************************************************************************
  382. *
  383. *
  384. 'DEBPROC' DEFDFORS ;
  385. 'ARGUMENT' rmax/'FLOTTANT' ;
  386. 'ARGUMENT' lnclk/'LOGIQUE' ;
  387. *
  388. 'SI' ('NON' ('EXISTE' lnclk)) ;
  389. lnclk = FAUX ;
  390. 'FINSI' ;
  391. gmabs = gmass2 _hau tdisc 'NPRI' discv 'NDUA' discv ;
  392. 'SI' tbfor ;
  393. fblob
  394. desfb fvolb =
  395. REDUS hau
  396. fblonn
  397. desfd fpvolnn ;
  398. fblol
  399. desfl fvoll =
  400. KRESS gmabs
  401. fblob
  402. desfb fvolb ;
  403. 'SINON' ;
  404. fblob
  405. fgrab fsurb fforb
  406. desfb fvolb =
  407. REDUS hau
  408. fblonn
  409. fgrann fsurnn ffornn
  410. desfd fpvolnn ;
  411. fblol
  412. fgral fsurl fforl
  413. desfl fvoll =
  414. KRESS gmabs
  415. fblob
  416. fgrab fsurb fforb
  417. desfb fvolb ;
  418. 'FINSI' ;
  419. ihau = 'INVERSE' hau ;
  420. i=0 ;
  421. tabev = 'TABLE' ;
  422. tabt = 'TABLE' ;
  423. i = '+' i 1 ;
  424. tabev . i = 'EVOL' 'CHPO' fblol 'SCAL' ihau ;
  425. tabt . i = 'CHAINE' 'Fint' ;
  426. 'SI' ('NON' tbfor) ;
  427. i = '+' i 1 ;
  428. tabev . i = 'EVOL' 'CHPO' fgral 'SCAL' ihau ;
  429. tabt . i = 'CHAINE' 'RhoG' ;
  430. i = '+' i 1 ;
  431. tabev . i = 'EVOL' 'CHPO' fsurl 'SCAL' ihau ;
  432. tabt . i = 'CHAINE' 'Tsurf' ;
  433. i = '+' i 1 ;
  434. tabev . i = 'EVOL' 'CHPO' fforl 'SCAL' ihau ;
  435. tabt . i = 'CHAINE' 'SouP' ;
  436. 'FINSI' ;
  437. i = '+' i 1 ;
  438. tabev . i = 'EVOL' 'CHPO' desfl 'SCAL' ihau ;
  439. tabt . i = 'CHAINE' 'DES' ;
  440. i = '+' i 1 ;
  441. tabev . i = 'EVOL' 'CHPO' fvoll 'SCAL' ihau ;
  442. tabt . i = 'CHAINE' 'Incomp.' ;
  443. tix = 's' ; tiy = 'FY' ; tit = 'CHAINE' tiy '(' tix ')' ;
  444. 'SI' ('EXISTE' rmax) ;
  445. binf = '-' lav rmax ;
  446. bsup = '+' lav rmax ;
  447. dessevol (@STBL tabev) tabt tit tix tiy
  448. ('PROG' binf bsup) lnclk ;
  449. 'SINON' ;
  450. dessevol (@STBL tabev) tabt tit tix tiy
  451. lnclk ;
  452. 'FINSI' ;
  453. *'RESPRO' ..... ;
  454. *
  455. * End of procedure file DEFDFORS
  456. *
  457. 'FINPROC' ;
  458. *ENDPROCEDUR defdfors
  459. *BEGINPROCEDUR defmail
  460. ************************************************************************
  461. * NOM : DEFMAIL
  462. * DESCRIPTION :
  463. *
  464. *
  465. *
  466. * LANGAGE : GIBIANE-CAST3M
  467. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  468. * mél : gounand@semt2.smts.cea.fr
  469. **********************************************************************
  470. * VERSION : v1, 27/01/2011, version initiale
  471. * HISTORIQUE : v1, 27/01/2011, création
  472. * HISTORIQUE :
  473. * HISTORIQUE :
  474. ************************************************************************
  475. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  476. * en cas de modification de ce sous-programme afin de faciliter
  477. * la maintenance !
  478. ************************************************************************
  479. *
  480. *
  481. 'DEBPROC' DEFMAIL ;
  482. 'ARGUMENT' rsou*'FLOTTANT' ;
  483. 'ARGUMENT' lav*'FLOTTANT' ;
  484. 'ARGUMENT' lap*'FLOTTANT' ;
  485. 'ARGUMENT' prof*'FLOTTANT' ;
  486. 'ARGUMENT' raff*'ENTIER' ;
  487. *
  488. tdisc = JETMOD ;
  489. vdim = 'VALEUR' 'DIME' ;
  490. raf2 = '*' 2 raff ;
  491. raf4 = '*' 4 raff ;
  492. raf8 = '*' 8 raff ;
  493. raf16 = '*' 16 raff ;
  494. raf32 = '*' 32 raff ;
  495. *
  496. dr = '/' rsou raff ;
  497. dav = '/' lav raff ;
  498. dap = '/' lap raff ;
  499. drp = '/' prof raff ;
  500. *
  501. mlav = '*' lav -1. ;
  502. mrsou = '*' rsou -1. ;
  503. mprof = '*' prof -1. ;
  504. 'SI' ('EGA' vdim 2) ;
  505. pA = mlav mprof ; pB = mrsou mprof ; pC = 0. mprof ;
  506. pD = rsou mprof ; pE = lap mprof ;
  507. *pJ = mlav 0. ; pII = mrsou 0. ; pH = 0. -0.5 ;
  508. pJ = mlav 0. ; pII = mrsou 0. ; pH = 0. 0. ;
  509. pG = rsou 0. ; pF = lap 0. ;
  510. *
  511. lAB = 'DROIT' pA pB 'DINI' dav 'DFIN' dr ;
  512. lBC = 'DROIT' pB pC 'DINI' dr 'DFIN' dr ;
  513. lCD = 'DROIT' pC pD 'DINI' dr 'DFIN' dr ;
  514. lDE = 'DROIT' pD pE 'DINI' dr 'DFIN' dap ;
  515. lEF = 'DROIT' pE pF 'DINI' drp 'DFIN' dr ;
  516. lFG = 'DROIT' pF pG 'DINI' dap 'DFIN' dr ;
  517. lGH = 'DROIT' pG pH 'DINI' dr 'DFIN' dr ;
  518. lHII = 'DROIT' pH pII 'DINI' dr 'DFIN' dr ;
  519. lIIJ = 'DROIT' pII pJ 'DINI' dr 'DFIN' dav ;
  520. lJA = 'DROIT' pJ pA 'DINI' dr 'DFIN' drp ;
  521. *
  522. bas = lAB 'ET' lBC 'ET' lCD 'ET' lDE ;
  523. dro = lEF ;
  524. hau = LFG 'ET' lGH 'ET' lHII 'ET' lIIJ ;
  525. gau = lJA ;
  526. mtw = 'DALLER' bas dro hau gau ;
  527. cmtw = 'CONTOUR' mtw ;
  528. *'TRACER' mtw ;
  529. *
  530. _bas _dro _hau _gau _cmtw _mtw =
  531. QUAFME bas dro hau gau cmtw mtw ;
  532. 'ELIMINATION'
  533. (_bas 'ET' _dro 'ET' _hau 'ET' _gau
  534. 'ET' _cmtw 'ET' _mtw)
  535. (1.D-5 '*' rsou) ;
  536. 'FINSI' ;
  537. 'SI' ('EGA' vdim 3) ;
  538. pA = mlav 0. mprof ; pB = mrsou 0. mprof ; pC = 0. 0. mprof ;
  539. pD = rsou 0. mprof ; pE = lap 0. mprof ;
  540. *pJ = mlav 0. ; pII = mrsou 0. ; pH = 0. -0.5 ;
  541. pJ = mlav 0. 0. ; pII = mrsou 0. 0. ; pH = 0. 0. 0. ;
  542. pG = rsou 0. 0. ; pF = lap 0. 0. ;
  543. *
  544. lAB = 'DROIT' pA pB 'DINI' dav 'DFIN' dr ;
  545. lBC = 'DROIT' pB pC 'DINI' dr 'DFIN' dr ;
  546. lCD = 'DROIT' pC pD 'DINI' dr 'DFIN' dr ;
  547. lDE = 'DROIT' pD pE 'DINI' dr 'DFIN' dap ;
  548. lEF = 'DROIT' pE pF 'DINI' drp 'DFIN' dr ;
  549. lFG = 'DROIT' pF pG 'DINI' dap 'DFIN' dr ;
  550. lGH = 'DROIT' pG pH 'DINI' dr 'DFIN' dr ;
  551. lHII = 'DROIT' pH pII 'DINI' dr 'DFIN' dr ;
  552. lIIJ = 'DROIT' pII pJ 'DINI' dr 'DFIN' dav ;
  553. lJA = 'DROIT' pJ pA 'DINI' dr 'DFIN' drp ;
  554. *
  555. bas2 = lAB 'ET' lBC 'ET' lCD 'ET' lDE ;
  556. dro2 = lEF ;
  557. hau2 = LFG 'ET' lGH 'ET' lHII 'ET' lIIJ ;
  558. gau2 = lJA ;
  559. fro = 'DALLER' bas2 dro2 hau2 gau2 ;
  560. dhau = 'INVERSE' hau2 ;
  561. * cmtw2 = 'CONTOUR' mtw2 ;
  562. *
  563. vtran = 0. lav 0. ;
  564. * vtran = 0. ('*' rsou 2.) 0. ;
  565. pH2 = 'PLUS' pH (0. rsou 0.) ;
  566. pH3 = 'PLUS' pH vtran ;
  567. lgen1 = 'DROIT' pH pH2 'DINI' dr 'DFIN' dr ;
  568. lgen2 = 'DROIT' pH2 pH3 'DINI' dr 'DFIN' dav ;
  569. lgen = lgen1 'ET' lgen2 ;
  570. * lgen = 'DROIT' 1 pH pH3 ;
  571. *
  572. rea = 'PLUS' fro vtran ;
  573. bas = 'GENERATRICE' bas2 lgen ;
  574. dro = 'GENERATRICE' dro2 lgen ;
  575. hau = 'GENERATRICE' hau2 lgen ;
  576. gau = 'GENERATRICE' gau2 lgen ;
  577. mtw = 'VOLUME' fro 'GENE' lgen ;
  578. cmtw = 'ENVELOPPE' mtw ;
  579. pint = 0. rsou ('/' mprof 2.) ;
  580. cmtw = 'ORIENTER' cmtw 'POIN' pint ;
  581. bhau1 = lgen 'PLUS' pJ ;
  582. bhau2 = lgen 'PLUS' pF ;
  583. bhau = bhau1 'ET' bhau2 ;
  584. *
  585. * 'TRACER' mtw ;
  586. *
  587. _bas _dro _hau _dhau _bhau _gau _fro _rea _cmtw _mtw =
  588. QUAFME bas dro hau dhau bhau gau fro rea cmtw mtw ;
  589. 'ELIMINATION'
  590. (_bas 'ET' _dro 'ET' _hau 'ET' _dhau 'ET' _bhau 'ET' _gau
  591. 'ET' _fro 'ET' _rea 'ET' _cmtw 'ET' _mtw)
  592. (1.D-5 '*' rsou) ;
  593. 'FINSI' ;
  594. *
  595. * vnor = GNOR _cmtw tdisc 'NPRI' discg 'FPRI' 1. 'NDUA' 'XN' ;
  596. * NOMDEP = @STBL (TDISC . 'XN' . 'NOMINC') ;
  597. * vnorn = '/' vnor ('**' ('PSCAL' vnor vnor nomdep nomdep) 0.5 ) ;
  598. * trvec cmtw vnorn 'Vnorn' ;
  599. *
  600. tdisc . 'mtw' = 'TABLE' ;
  601. tdisc . 'mtw' .'QUAF' = _mtw ; tdisc . 'mtw' .'LINE' = mtw ;
  602. tdisc . 'cmtw' = 'TABLE' ;
  603. tdisc . 'cmtw' .'QUAF' = _cmtw ; tdisc . 'cmtw' .'LINE' = cmtw ;
  604. tdisc . 'bas' = 'TABLE' ;
  605. tdisc . 'bas' .'QUAF' = _bas ; tdisc . 'bas' .'LINE' = bas ;
  606. tdisc . 'dro' = 'TABLE' ;
  607. tdisc . 'dro' .'QUAF' = _dro ; tdisc . 'dro' .'LINE' = dro ;
  608. tdisc . 'hau' = 'TABLE' ;
  609. tdisc . 'hau' .'QUAF' = _hau ; tdisc . 'hau' .'LINE' = hau ;
  610. tdisc . 'gau' = 'TABLE' ;
  611. tdisc . 'gau' .'QUAF' = _gau ; tdisc . 'gau' .'LINE' = gau ;
  612. 'SI' ('EGA' vdim 3) ;
  613. tdisc . 'fro' = 'TABLE' ;
  614. tdisc . 'fro' .'QUAF' = _fro ; tdisc . 'fro' .'LINE' = fro ;
  615. tdisc . 'rea' = 'TABLE' ;
  616. tdisc . 'rea' .'QUAF' = _rea ; tdisc . 'rea' .'LINE' = rea ;
  617. tdisc . 'dhau' = 'TABLE' ;
  618. tdisc . 'dhau' .'QUAF' = _dhau ; tdisc . 'dhau' .'LINE' = dhau ;
  619. tdisc . 'bhau' = 'TABLE' ;
  620. tdisc . 'bhau' .'QUAF' = _bhau ; tdisc . 'bhau' .'LINE' = bhau ;
  621. 'FINSI' ;
  622. *
  623. 'RESPRO' tdisc ;
  624. *
  625. * End of procedure file DEFMAIL
  626. *
  627. 'FINPROC' ;
  628. *ENDPROCEDUR defmail
  629. *BEGINPROCEDUR defqfors
  630. ************************************************************************
  631. * NOM : DEFQFORS
  632. * DESCRIPTION :
  633. *
  634. *
  635. *
  636. * LANGAGE : GIBIANE-CAST3M
  637. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  638. * mél : gounand@semt2.smts.cea.fr
  639. **********************************************************************
  640. * VERSION : v1, ??/??/2007, version initiale
  641. * HISTORIQUE : v1, ??/??/2007, création
  642. * HISTORIQUE :
  643. * HISTORIQUE :
  644. ************************************************************************
  645. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  646. * en cas de modification de ce sous-programme afin de faciliter
  647. * la maintenance !
  648. ************************************************************************
  649. *
  650. *
  651. 'DEBPROC' DEFQFORS ;
  652. 'ARGUMENT' rmax/'FLOTTANT' ;
  653. 'ARGUMENT' lnclk/'LOGIQUE' ;
  654. *
  655. 'SI' ('NON' ('EXISTE' lnclk)) ;
  656. lnclk = FAUX ;
  657. 'FINSI' ;
  658. gmabs = gmass2 _hau tdisc 'NPRI' discv 'NDUA' discv ;
  659. 'SI' tbfor ;
  660. fpreb frigb fugrb desfb
  661. fpgrab ftsurb fpforb
  662. * ftanrb
  663. fblonb fbloxb fbloyb =
  664. REDUS hau
  665. fpre frig fugr desfq
  666. fpgra ftsur fpfor
  667. * ftanr
  668. fblon fblox fbloy ;
  669. 'SINON' ;
  670. fpreb frigb fugrb desfb
  671. fblonb fbloxb fbloyb =
  672. REDUS hau
  673. fpre frig fugr desfq
  674. fblon fblox fbloy ;
  675. 'FINSI' ;
  676. vnor = DEFDD tdisc 0 ;
  677. *
  678. * Décomposition en composante normale et tangentielle
  679. *
  680. 'SI' tbfor ;
  681. fpren fpret frign frigt fugrn fugrt desfn desft
  682. fgran fgrat fsurn fsurt fforn ffort
  683. * ftanrn ftanrt
  684. fblonn fblont fbloxn fbloxt fbloyn fbloyt
  685. = NORTANS vnor
  686. fpreb frigb fugrb desfb
  687. fpgra ftsur fpfor
  688. * ftanr
  689. fblonb fbloxb fbloyb ;
  690. *
  691. fpren fpret frign frigt fugrn fugrt desfn desft
  692. fgran fgrat fsurn fsurt fforn ffort
  693. * ftanrn ftanrt
  694. fblonn fblont fbloxn fbloxt fbloyn fbloyt
  695. = KRESS gmabs
  696. fpren fpret frign frigt fugrn fugrt desfn desft
  697. fgran fgrat fsurn fsurt fforn ffort
  698. * ftanrn ftanrt
  699. fblonn fblont fbloxn fbloxt fbloyn fbloyt
  700. ;
  701. 'SINON' ;
  702. fpren fpret frign frigt fugrn fugrt desfn desft
  703. fblonn fblont fbloxn fbloxt fbloyn fbloyt
  704. = NORTANS vnor
  705. fpreb frigb fugrb desfb
  706. fblonb fbloxb fbloyb ;
  707. *
  708. fpren fpret frign frigt fugrn fugrt desfn desft
  709. fblonn fblont fbloxn fbloxt fbloyn fbloyt
  710. = KRESS gmabs
  711. fpren fpret frign frigt fugrn fugrt desfn desft
  712. fblonn fblont fbloxn fbloxt fbloyn fbloyt
  713. ;
  714. 'FINSI' ;
  715. ihau = 'INVERSE' hau ;
  716. i=0 ;
  717. tabev = 'TABLE' ;
  718. tabt = 'TABLE' ;
  719. i = '+' i 1 ;
  720. tabev . i = 'EVOL' 'CHPO' fpret 'SCAL' ihau ;
  721. tabt . i = 'CHAINE' 'GradP' ;
  722. i = '+' i 1 ;
  723. tabev . i = 'EVOL' 'CHPO' frigt 'SCAL' ihau ;
  724. tabt . i = 'CHAINE' 'LapnU' ;
  725. i = '+' i 1 ;
  726. tabev . i = 'EVOL' 'CHPO' fugrt 'SCAL' ihau ;
  727. tabt . i = 'CHAINE' 'UgradU' ;
  728. i = '+' i 1 ;
  729. tabev . i = 'EVOL' 'CHPO' desft 'SCAL' ihau ;
  730. tabt . i = 'CHAINE' 'DES' ;
  731. 'SI' tbfor ;
  732. i = '+' i 1 ;
  733. tabev . i = 'EVOL' 'CHPO' fgrat 'SCAL' ihau ;
  734. tabt . i = 'CHAINE' 'Gravi' ;
  735. i = '+' i 1 ;
  736. tabev . i = 'EVOL' 'CHPO' fsurt 'SCAL' ihau ;
  737. tabt . i = 'CHAINE' 'T. Sur' ;
  738. i = '+' i 1 ;
  739. tabev . i = 'EVOL' 'CHPO' ffort 'SCAL' ihau ;
  740. tabt . i = 'CHAINE' 'Sou. Pr' ;
  741. * i = '+' i 1 ;
  742. * tabev . i = 'EVOL' 'CHPO' ftanrt 'SCAL' ihau ;
  743. * tabt . i = 'CHAINE' 'Sor. lib.' ;
  744. 'FINSI' ;
  745. i = '+' i 1 ;
  746. tabev . i = 'EVOL' 'CHPO' fblont 'SCAL' ihau ;
  747. tabt . i = 'CHAINE' 'BlocN' ;
  748. i = '+' i 1 ;
  749. tabev . i = 'EVOL' 'CHPO' fbloxt 'SCAL' ihau ;
  750. tabt . i = 'CHAINE' 'BlocX' ;
  751. i = '+' i 1 ;
  752. tabev . i = 'EVOL' 'CHPO' fbloyt 'SCAL' ihau ;
  753. tabt . i = 'CHAINE' 'BlocY' ;
  754. tix = 's' ; tiy = 'Ftan' ; tit = 'CHAINE' tiy '(' tix ')' ;
  755. 'SI' ('EXISTE' rmax) ;
  756. binf = '-' lav rmax ;
  757. bsup = '+' lav rmax ;
  758. dessevol (@STBL tabev) tabt tit tix tiy
  759. ('PROG' binf bsup) lnclk ;
  760. 'SINON' ;
  761. dessevol (@STBL tabev) tabt tit tix tiy
  762. lnclk ;
  763. 'FINSI' ;
  764. i=0 ;
  765. tabev = 'TABLE' ;
  766. tabt = 'TABLE' ;
  767. i = '+' i 1 ;
  768. tabev . i = 'EVOL' 'CHPO' fpren 'SCAL' ihau ;
  769. tabt . i = 'CHAINE' 'GradP' ;
  770. i = '+' i 1 ;
  771. tabev . i = 'EVOL' 'CHPO' frign 'SCAL' ihau ;
  772. tabt . i = 'CHAINE' 'LapnU' ;
  773. i = '+' i 1 ;
  774. tabev . i = 'EVOL' 'CHPO' fugrn 'SCAL' ihau ;
  775. tabt . i = 'CHAINE' 'UgradU' ;
  776. i = '+' i 1 ;
  777. tabev . i = 'EVOL' 'CHPO' desfn 'SCAL' ihau ;
  778. tabt . i = 'CHAINE' 'DES' ;
  779. 'SI' tbfor ;
  780. i = '+' i 1 ;
  781. tabev . i = 'EVOL' 'CHPO' fgran 'SCAL' ihau ;
  782. tabt . i = 'CHAINE' 'RhoG' ;
  783. i = '+' i 1 ;
  784. tabev . i = 'EVOL' 'CHPO' fsurn 'SCAL' ihau ;
  785. tabt . i = 'CHAINE' 'Tsurf' ;
  786. i = '+' i 1 ;
  787. tabev . i = 'EVOL' 'CHPO' fforn 'SCAL' ihau ;
  788. tabt . i = 'CHAINE' 'Sou. P' ;
  789. * i = '+' i 1 ;
  790. * tabev . i = 'EVOL' 'CHPO' ftanrn 'SCAL' ihau ;
  791. * tabt . i = 'CHAINE' 'Sor. lib.' ;
  792. 'FINSI' ;
  793. i = '+' i 1 ;
  794. tabev . i = 'EVOL' 'CHPO' fblonn 'SCAL' ihau ;
  795. tabt . i = 'CHAINE' 'BlocN' ;
  796. i = '+' i 1 ;
  797. tabev . i = 'EVOL' 'CHPO' fbloxn 'SCAL' ihau ;
  798. tabt . i = 'CHAINE' 'BlocX' ;
  799. i = '+' i 1 ;
  800. tabev . i = 'EVOL' 'CHPO' fbloyn 'SCAL' ihau ;
  801. tabt . i = 'CHAINE' 'BlocY' ;
  802. tix = 's' ; tiy = 'Fnor' ; tit = 'CHAINE' tiy '(' tix ')' ;
  803. 'SI' ('EXISTE' rmax) ;
  804. binf = '-' lav rmax ;
  805. bsup = '+' lav rmax ;
  806. dessevol (@STBL tabev) tabt tit tix tiy
  807. ('PROG' binf bsup) lnclk ;
  808. 'SINON' ;
  809. dessevol (@STBL tabev) tabt tit tix tiy
  810. lnclk ;
  811. 'FINSI' ;
  812. *
  813. * End of procedure file DEFQFORS
  814. *
  815. 'FINPROC' ;
  816. *ENDPROCEDUR defqfors
  817. *BEGINPROCEDUR defsumm
  818. ************************************************************************
  819. * NOM : DEFSUMM
  820. * DESCRIPTION :
  821. *
  822. *
  823. *
  824. * LANGAGE : GIBIANE-CAST3M
  825. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  826. * mél : gounand@semt2.smts.cea.fr
  827. **********************************************************************
  828. * VERSION : v1, ??/??/2007, version initiale
  829. * HISTORIQUE : v1, ??/??/2007, création
  830. * HISTORIQUE :
  831. * HISTORIQUE :
  832. ************************************************************************
  833. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  834. * en cas de modification de ce sous-programme afin de faciliter
  835. * la maintenance !
  836. ************************************************************************
  837. *
  838. *
  839. 'DEBPROC' DEFSUMM ;
  840. 'MESSAGE' ('CHAINE' 'Parametres physiques :') ;
  841. 'MESSAGE' ('CHAINE' '**********************') ;
  842. *
  843. 'MESSAGE' ('CHAINE' 'Parametres adimensionnels :') ;
  844. 'MESSAGE' ('CHAINE' '***************************') ;
  845. 'MESSAGE' ('CHAINE' ' Nombre dEuler = ' (formar Eu 3)) ;
  846. 'MESSAGE' ('CHAINE' ' Nombre de Reynolds = ' (formar Re 3)) ;
  847. 'MESSAGE' ('CHAINE' ' Nombre de Froude*Euler = ' (formar FrEu 3)) ;
  848. 'MESSAGE' ('CHAINE' ' Nombre de Weber = ' (formar We 3)) ;
  849. 'MESSAGE' ('CHAINE' 'Numérique :') ;
  850. 'MESSAGE' ('CHAINE' '-----------') ;
  851. 'MESSAGE' ('CHAINE' 'raff=' raff
  852. ' nelem= ' ('NBEL' mtw) ' npo= ' ('NBNO' mtw)) ;
  853. 'MESSAGE' ('CHAINE' 'itcou= ' itcou ' nitermax=' nitermax) ;
  854. 'MESSAGE' ('CHAINE' 'nitn= ' nitn ' omegn=' (formar omegn 2)) ;
  855. 'MESSAGE' ('CHAINE' 'omegd=' (formar omegd 2)) ;
  856. 'MESSAGE' ('CHAINE' 'nomdir=' nomdir) ;
  857. 'MESSAGE' ('CHAINE' 'nomfic=' nomfic) ;
  858. *
  859. * End of procedure file DEFSUMM
  860. *
  861. 'FINPROC' ;
  862. *ENDPROCEDUR defsumm
  863. *BEGINPROCEDUR defvsurf
  864. ************************************************************************
  865. * NOM : DEFVSURF
  866. * DESCRIPTION :
  867. *
  868. *
  869. *
  870. * LANGAGE : GIBIANE-CAST3M
  871. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  872. * mél : gounand@semt2.smts.cea.fr
  873. **********************************************************************
  874. * VERSION : v1, ??/??/2007, version initiale
  875. * HISTORIQUE : v1, ??/??/2007, création
  876. * HISTORIQUE :
  877. * HISTORIQUE :
  878. ************************************************************************
  879. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  880. * en cas de modification de ce sous-programme afin de faciliter
  881. * la maintenance !
  882. ************************************************************************
  883. *
  884. *
  885. 'DEBPROC' DEFVSURF ;
  886. 'ARGUMENT' rmax/'FLOTTANT' ;
  887. 'ARGUMENT' lnclk/'LOGIQUE' ;
  888. *
  889. 'SI' ('NON' ('EXISTE' lnclk)) ;
  890. lnclk = FAUX ;
  891. 'FINSI' ;
  892. vdim = 'VALEUR' 'DIME' ;
  893. 'SI' ('EGA' vdim 2) ;
  894. ihau = 'INVERSE' hau ;
  895. 'SINON' ;
  896. ihau = dhau ;
  897. 'FINSI' ;
  898. i=0 ;
  899. tabev = 'TABLE' ;
  900. tabt = 'TABLE' ;
  901. i = '+' i 1 ;
  902. rhau = 'EXTRAIRE' ('EVOL' 'CHPO' ('COORDONNEE' 1 hau) 'SCAL' ihau)
  903. 'ORDO' ;
  904. hv = 'REDU' vit ihau ;
  905. NOMDEP = @STBL (TDISC . 'XN' . 'NOMINC') ;
  906. nhv = '**' ('PSCAL' vit vit nomdep nomdep) 0.5 ;
  907. zhau = 'EXTRAIRE' ('EVOL' 'CHPO' nhv 'SCAL' ihau) 'ORDO' ;
  908. tabev . i = 'EVOL' 'MANU' rhau zhau ;
  909. tabt . i = 'CHAINE' '|V| surf' ;
  910. tix = 's' ; tiy = '|V|' ; tit = 'CHAINE' tiy '(' tix ')' ;
  911. 'SI' ('EXISTE' rmax) ;
  912. binf = '-' 0. rmax ;
  913. bsup = '+' 0. rmax ;
  914. dessevol (@STBL tabev) tabt tit tix tiy
  915. ('PROG' binf bsup) lnclk ;
  916. 'SINON' ;
  917. dessevol (@STBL tabev) tabt tit tix tiy
  918. lnclk ;
  919. 'FINSI' ;
  920. *'SINON' ;
  921. * 'SI' ('EXISTE' rmax) ;
  922. * xhau = 'COORDONNEE' 1 hau ;
  923. * yhau = 'COORDONNEE' 2 hau ;
  924. * rhau = '**' ('+' ('**' xhau 2) ('**' yhau 2)) 0.5 ;
  925. * phau = 'POIN' rhau 'INFERIEUR' rmax ;
  926. * redhau = 'ELEM' hau 'APPUYE' 'LARGEMENT' phau ;
  927. * 'SINON' ;
  928. * redhau = hau ;
  929. * 'FINSI' ;
  930. * 'SI' lnclk ;
  931. * 'TRACER' 'CACH' redhau 'TITR' 'Surface' 'NCLK' ;
  932. * 'SINON' ;
  933. * 'TRACER' 'CACH' redhau 'TITR' 'Surface' 'NCLK' ;
  934. * 'FINSI' ;
  935. *'FINSI' ;
  936. *
  937. * End of procedure file DEFVSURF
  938. *
  939. 'FINPROC' ;
  940. *ENDPROCEDUR defvsurf
  941. *BEGINPROCEDUR defzsurf
  942. ************************************************************************
  943. * NOM : DEFZSURF
  944. * DESCRIPTION :
  945. *
  946. *
  947. *
  948. * LANGAGE : GIBIANE-CAST3M
  949. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  950. * mél : gounand@semt2.smts.cea.fr
  951. **********************************************************************
  952. * VERSION : v1, ??/??/2007, version initiale
  953. * HISTORIQUE : v1, ??/??/2007, création
  954. * HISTORIQUE :
  955. * HISTORIQUE :
  956. ************************************************************************
  957. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  958. * en cas de modification de ce sous-programme afin de faciliter
  959. * la maintenance !
  960. ************************************************************************
  961. *
  962. *
  963. 'DEBPROC' DEFZSURF ;
  964. 'ARGUMENT' rmax/'FLOTTANT' ;
  965. 'ARGUMENT' lnclk/'LOGIQUE' ;
  966. *
  967. 'SI' ('NON' ('EXISTE' lnclk)) ;
  968. lnclk = FAUX ;
  969. 'FINSI' ;
  970. vdim = 'VALEUR' 'DIME' ;
  971. 'SI' ('EGA' vdim 2) ;
  972. ihau = 'INVERSE' hau ;
  973. 'SINON' ;
  974. ihau = dhau ;
  975. 'FINSI' ;
  976. i=0 ;
  977. tabev = 'TABLE' ;
  978. tabt = 'TABLE' ;
  979. i = '+' i 1 ;
  980. rhau = 'EXTRAIRE' ('EVOL' 'CHPO' ('COORDONNEE' 1 hau) 'SCAL' ihau)
  981. 'ORDO' ;
  982. zhau = 'EXTRAIRE' ('EVOL' 'CHPO' ('COORDONNEE' vdim hau)
  983. 'SCAL' ihau) 'ORDO' ;
  984. tabev . i = 'EVOL' 'MANU' rhau zhau ;
  985. tabt . i = 'CHAINE' 'z surf' ;
  986. tix = 's' ; tiy = 'z' ; tit = 'CHAINE' tiy '(' tix ')' ;
  987. 'SI' ('EXISTE' rmax) ;
  988. binf = '-' 0. rmax ;
  989. bsup = '+' 0. rmax ;
  990. dessevol (@STBL tabev) tabt tit tix tiy
  991. ('PROG' binf bsup) lnclk ;
  992. 'SINON' ;
  993. dessevol (@STBL tabev) tabt tit tix tiy
  994. lnclk ;
  995. 'FINSI' ;
  996. *'SINON' ;
  997. * 'SI' ('EXISTE' rmax) ;
  998. * xhau = 'COORDONNEE' 1 hau ;
  999. * yhau = 'COORDONNEE' 2 hau ;
  1000. * rhau = '**' ('+' ('**' xhau 2) ('**' yhau 2)) 0.5 ;
  1001. * phau = 'POIN' rhau 'INFERIEUR' rmax ;
  1002. * redhau = 'ELEM' hau 'APPUYE' 'LARGEMENT' phau ;
  1003. * 'SINON' ;
  1004. * redhau = hau ;
  1005. * 'FINSI' ;
  1006. * 'SI' lnclk ;
  1007. * 'TRACER' 'CACH' redhau 'TITR' 'Surface' 'NCLK' ;
  1008. * 'SINON' ;
  1009. * 'TRACER' 'CACH' redhau 'TITR' 'Surface' 'NCLK' ;
  1010. * 'FINSI' ;
  1011. *'FINSI' ;
  1012. *
  1013. * End of procedure file DEFZSURF
  1014. *
  1015. 'FINPROC' ;
  1016. *ENDPROCEDUR defzsurf
  1017. *BEGINPROCEDUR dessevol
  1018. ************************************************************************
  1019. * NOM : DESSEVOL
  1020. * DESCRIPTION : Dessine des évolutions : choisit automatiquement
  1021. * les options, marqueurs, couleurs...
  1022. *
  1023. *
  1024. * LANGAGE : GIBIANE-CAST3M
  1025. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1026. * mél : gounand@semt2.smts.cea.fr
  1027. **********************************************************************
  1028. * VERSION : v1, 16/11/2004, version initiale
  1029. * HISTORIQUE : v1, 16/11/2004, création
  1030. * HISTORIQUE :
  1031. * HISTORIQUE :
  1032. ************************************************************************
  1033. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1034. * en cas de modification de ce sous-programme afin de faciliter
  1035. * la maintenance !
  1036. ************************************************************************
  1037. *
  1038. *
  1039. 'DEBPROC' DESSEVOL ;
  1040. 'ARGUMENT' evtot*'EVOLUTION' ;
  1041. 'ARGUMENT' tabt*'TABLE' ;
  1042. 'ARGUMENT' tit*'MOT' ;
  1043. 'ARGUMENT' tix*'MOT' ;
  1044. 'ARGUMENT' tiy*'MOT' ;
  1045. 'ARGUMENT' lnclk/'LOGIQUE' ;
  1046. 'ARGUMENT' nb/'ENTIER' ;
  1047. 'ARGUMENT' lx/'LISTREEL' ;
  1048. *
  1049. 'SI' ('NON' ('EXISTE' lnclk)) ;
  1050. lnclk = FAUX ;
  1051. 'FINSI' ;
  1052. *
  1053. * nb = 0 : noir et blanc
  1054. * nb = 1 : couleur
  1055. * nb = 2 : couleur + marqueurs
  1056. * nb = 3 : couleur + marqueurs + tirets
  1057. * nb = 4 : couleur + marqueurs regu
  1058. * nb = 5 : couleur + marqueurs regu + tirets
  1059. * nb = 6 : nb + marqueurs regu + tirets
  1060. * nb = 7 : nb + marqueurs
  1061. * nb = 8 : nb + marqueurs regu
  1062. *
  1063. 'SI' ('NON' ('EXISTE' nb)) ;
  1064. nb = 3 ;
  1065. 'FINSI' ;
  1066. *
  1067. nt = 'DIME' tabt ;
  1068. nev = 'DIME' evtot ;
  1069. *
  1070. * Attention, dans evtot, il y a une évolution avec des noms de points ?
  1071. *
  1072. *'SI' ('NEG' nev nt) ;
  1073. * cherr = 'CHAINE' 'Evolution and title table : not same dim.' ;
  1074. * 'ERREUR' cherr ;
  1075. *'FINSI' ;
  1076. *
  1077. tev = 'TABLE' ;
  1078. tev . 'TITRE' = tabt ;
  1079. *
  1080. toto = 'TABLE' ;
  1081. *
  1082. *lcoul = 'MOTS' 'TURQ' 'VERT' 'JAUN' 'ROSE' 'ROUG' 'BLEU' ;
  1083. 'SI' ('EGA' ('VALEUR' 'TRAC') 'PSC') ;
  1084. lcoul = 'MOTS' 'BLEU' 'ROUG' 'VERT' 'VIOL' 'OLIV' 'ORAN' ;
  1085. 'SINON' ;
  1086. lcoul = 'MOTS' 'TURQ' 'VERT' 'JAUN' 'ROSE' 'ROUG' 'BLEU' ;
  1087. 'FINSI' ;
  1088. lmarq = 'MOTS' 'TRID' 'TRIU' 'LOSA' 'CARR' 'ETOI' 'PLUS' 'CROI'
  1089. 'TRIL' 'TRIR' ;
  1090. ltirr = 'MOTS' 'TIRR' 'TIRC' 'TIRL' 'TIRM' ;
  1091. *
  1092. lnb = 'LECT' 0 6 7 8 ;
  1093. *'SI' ('OU' ('EGA' nb 0) ('EGA' nb 6)) ;
  1094. 'SI' (dans ('LECT' nb) lnb) ;
  1095. ev2 = evtot ;
  1096. 'SINON' ;
  1097. icou = 0 ;
  1098. 'REPETER' iev nev ;
  1099. ii = &iev ;
  1100. evi = 'EXTRAIRE' evtot 'COUR' ii ;
  1101. 'SI' ('NEG' ('TYPE' ('EXTRAIRE' evi 'ORDO')) 'LISTMOTS') ;
  1102. icou = '+' icou 1 ;
  1103. 'FINSI' ;
  1104. * ii2 = '/' ('+' ii 1) 2 ;
  1105. * ci = EXMOMOD lcoul ii2 ;
  1106. * ci = EXMOMOD lcoul ii ;
  1107. ci = EXMOMOD lcoul icou ;
  1108. APPEND toto 'EVOLUTION' ('COULEUR' evi ci) ;
  1109. 'FIN' iev ;
  1110. ev2 = toto . 'EVOLUTION' ;
  1111. 'FINSI' ;
  1112. *
  1113. 'REPETER' iev nev ;
  1114. ii = &iev ;
  1115. mi = EXMOMOD lmarq ii ;
  1116. ti = EXMOMOD ltirr ii ;
  1117. 'SI' ('OU' ('EGA' nb 2) ('EGA' nb 7)) ;
  1118. tev . ii = 'CHAINE' 'MARQ ' mi ;
  1119. 'FINSI' ;
  1120. 'SI' ('EGA' nb 3) ;
  1121. tev . ii = 'CHAINE' 'MARQ ' mi ' ' ti ;
  1122. 'FINSI' ;
  1123. 'SI' ('OU' ('EGA' nb 4) ('EGA' nb 8)) ;
  1124. tev . ii = 'CHAINE' 'MARQ ' mi ' REGU' ;
  1125. 'FINSI' ;
  1126. 'SI' ('OU' ('EGA' nb 5) ('EGA' nb 6)) ;
  1127. tev . ii = 'CHAINE' 'MARQ ' mi ' ' ti ' REGU' ;
  1128. 'FINSI' ;
  1129. 'FIN' iev ;
  1130. *
  1131. 'SI' ('EXISTE' lx) ;
  1132. dim4 = 'EGA' ('DIME' lx) 4 ;
  1133. xmin = 'EXTRAIRE' lx 1 ; xmax = 'EXTRAIRE' lx 2 ;
  1134. 'SI' dim4 ;
  1135. ymin = 'EXTRAIRE' lx 3 ; ymax = 'EXTRAIRE' lx 4 ;
  1136. 'FINSI' ;
  1137. 'SI' dim4 ;
  1138. 'SI' lnclk ;
  1139. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
  1140. 'XBOR' xmin xmax 'YBOR' ymin ymax 'NCLK' motopt ;
  1141. 'SINON' ;
  1142. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
  1143. 'XBOR' xmin xmax 'YBOR' ymin ymax motopt ;
  1144. 'FINSI' ;
  1145. 'SINON' ;
  1146. 'SI' lnclk ;
  1147. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
  1148. 'XBOR' xmin xmax 'NCLK' motopt ;
  1149. 'SINON' ;
  1150. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
  1151. 'XBOR' xmin xmax motopt ;
  1152. 'FINSI' ;
  1153. 'FINSI' ;
  1154. 'SINON' ;
  1155. 'SI' lnclk ;
  1156. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
  1157. 'NCLK' motopt ;
  1158. 'SINON' ;
  1159. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
  1160. motopt ;
  1161. 'FINSI' ;
  1162. 'FINSI' ;
  1163. *
  1164. * End of procedure file DESSEVOL
  1165. *
  1166. 'FINPROC' ;
  1167. *ENDPROCEDUR dessevol
  1168. *BEGINPROCEDUR errrel
  1169. ************************************************************************
  1170. * NOM : ERRREL
  1171. * DESCRIPTION : Calcul d'une erreur relative
  1172. *
  1173. *
  1174. *
  1175. * LANGAGE : GIBIANE-CAST3M
  1176. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1177. * mél : gounand@semt2.smts.cea.fr
  1178. **********************************************************************
  1179. * VERSION : v1, 23/04/2003, version initiale
  1180. * HISTORIQUE : v1, 23/04/2003, création
  1181. * HISTORIQUE :
  1182. * HISTORIQUE :
  1183. ************************************************************************
  1184. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1185. * en cas de modification de ce sous-programme afin de faciliter
  1186. * la maintenance !
  1187. ************************************************************************
  1188. *
  1189. *
  1190. 'DEBPROC' ERRREL ;
  1191. 'ARGUMENT' val*'FLOTTANT' ;
  1192. 'ARGUMENT' valref*'FLOTTANT' ;
  1193. *
  1194. 'SI' ('<' ('ABS' valref) 1.D-10) ;
  1195. echref = 1.D0 ;
  1196. 'SINON' ;
  1197. echref = valref ;
  1198. 'FINSI' ;
  1199. *
  1200. errabs = 'ABS' ('/' ('-' val valref) echref);
  1201. *
  1202. 'RESPRO' errabs ;
  1203. *
  1204. * End of procedure file ERRREL
  1205. *
  1206. 'FINPROC' ;
  1207. *ENDPROCEDUR errrel
  1208. *BEGINPROCEDUR exmomod
  1209. ************************************************************************
  1210. * NOM : EXMOMOD
  1211. * DESCRIPTION : Extraction d'un mot d'un listmots
  1212. *
  1213. *
  1214. *
  1215. * LANGAGE : GIBIANE-CAST3M
  1216. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1217. * mél : gounand@semt2.smts.cea.fr
  1218. **********************************************************************
  1219. * VERSION : v1, 23/06/2003, version initiale
  1220. * HISTORIQUE : v1, 23/06/2003, création
  1221. * HISTORIQUE :
  1222. * HISTORIQUE :
  1223. ************************************************************************
  1224. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1225. * en cas de modification de ce sous-programme afin de faciliter
  1226. * la maintenance !
  1227. ************************************************************************
  1228. *
  1229. *
  1230. 'DEBPROC' EXMOMOD ;
  1231. 'ARGUMENT' lm*'LISTMOTS' i*'ENTIER' ;
  1232. j = 'DIME' lm ;
  1233. k = '+' (MODULO ('-' i 1) j) 1 ;
  1234. lemot = 'EXTRAIRE' lm k ;
  1235. * Usage de l'opérateur text pour éviter que lemot
  1236. * ne soit interprété comme un opérateur
  1237. 'RESPRO' 'TEXTE' lemot ;
  1238. *
  1239. * End of procedure file EXMOMOD
  1240. *
  1241. 'FINPROC' ;
  1242. *ENDPROCEDUR exmomod
  1243. *BEGINPROCEDUR formar
  1244. ************************************************************************
  1245. * NOM : FORMAR
  1246. * DESCRIPTION : formate un réel de facon courte
  1247. * pratique pour les noms de
  1248. * sauvegarde
  1249. * Exemples :
  1250. * 'MESSAGE' ('CHAINE' (formar 2.9e5 1)) ;
  1251. * 2.9E5
  1252. * 'MESSAGE' ('CHAINE' (formar -2.9e5 1)) ;
  1253. * -2.9E5
  1254. * 'MESSAGE' ('CHAINE' (formar 2.9e-5 1)) ;
  1255. * 2.9E-5
  1256. * 'MESSAGE' ('CHAINE' (formar -2.9e-5 1)) ;
  1257. * -2.9E-5
  1258. * 'MESSAGE' ('CHAINE' (formar 2.9 1)) ;
  1259. * 2.9
  1260. * 'MESSAGE' ('CHAINE' (formar -2.9 1)) ;
  1261. * -2.9
  1262. * 'MESSAGE' ('CHAINE' (formar 0 1)) ;
  1263. * 0
  1264. * 'MESSAGE' ('CHAINE' (formar 0 1)) ;
  1265. * 0
  1266. * 'MESSAGE' ('CHAINE' (formar 2.9e5 0)) ;
  1267. * 3E5
  1268. * 'MESSAGE' ('CHAINE' (formar -2.9e5 0)) ;
  1269. * -3E5
  1270. * 'MESSAGE' ('CHAINE' (formar 2.9e-5 0)) ;
  1271. * 3E-5
  1272. * 'MESSAGE' ('CHAINE' (formar -2.9e-5 0)) ;
  1273. * -3E-5
  1274. * 'MESSAGE' ('CHAINE' (formar 2.9 0)) ;
  1275. * 3
  1276. * 'MESSAGE' ('CHAINE' (formar -2.9 0)) ;
  1277. * -3
  1278. * 'MESSAGE' ('CHAINE' (formar 0 0)) ;
  1279. * 0
  1280. * 'MESSAGE' ('CHAINE' (formar 0 0)) ;
  1281. * 0
  1282. *
  1283. *
  1284. *
  1285. * LANGAGE : GIBIANE-CAST3M
  1286. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1287. * mél : gounand@semt2.smts.cea.fr
  1288. **********************************************************************
  1289. * VERSION : v1, 18/02/2003, version initiale
  1290. * HISTORIQUE : v1, 18/02/2003, création
  1291. * HISTORIQUE :
  1292. * HISTORIQUE :
  1293. ************************************************************************
  1294. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1295. * en cas de modification de ce sous-programme afin de faciliter
  1296. * la maintenance !
  1297. ************************************************************************
  1298. *
  1299. *
  1300. 'DEBPROC' FORMAR ;
  1301. 'ARGUMENT' fl*'FLOTTANT' ;
  1302. 'ARGUMENT' vir/'ENTIER ' ;
  1303. 'SI' ('NON' ('EXISTE' vir)) ;
  1304. vir = 1 ;
  1305. 'SINON' ;
  1306. 'SI' ('<' vir 0) ;
  1307. 'ERREUR' 'fournir un entier positif' ;
  1308. 'FINSI' ;
  1309. 'FINSI' ;
  1310. 'SI' ('<' ('ABS' fl) 10.D-100) ;
  1311. chfl = 'CHAINE' '0' ;
  1312. 'SINON' ;
  1313. *! sans le 1.D-10, ca ne fonctionne pas
  1314. *! qd on entre pile poil une puissance de 10
  1315. lfl = LOG10 ('ABS' fl) ;
  1316. * lfl = '+' (LOG10 ('ABS' fl)) 1.D-10 ;
  1317. slfl = 'SIGNE' ('ENTIER' lfl) ;
  1318. 'SI' ('EGA' slfl 1) ;
  1319. elfl = 'ENTIER' lfl ;
  1320. 'SINON' ;
  1321. elfl = '-' ('ENTIER' lfl) 1 ;
  1322. 'FINSI' ;
  1323. man = '/' fl ('**' 10.D0 elfl) ;
  1324. *
  1325. * Une verrue pour des histoires de précision...
  1326. *
  1327. 'SI' ('EGA' man 10.D0 ('**' 10.D0 ('*' vir -1.D0))) ;
  1328. man = '/' man 10.D0 ;
  1329. elfl = '+' elfl 1 ;
  1330. 'FINSI' ;
  1331. *
  1332. sman = 'SIGNE' man ;
  1333. 'SI' ('EGA' sman 1) ;
  1334. fman = 'CHAINE' '(F' ('+' vir 2) '.0' vir ')' ;
  1335. 'SINON' ;
  1336. fman = 'CHAINE' '(F' ('+' vir 3) '.0' vir ')' ;
  1337. 'FINSI' ;
  1338. 'SI' ('NEG' vir 0) ;
  1339. 'SI' ('NEG' elfl 0) ;
  1340. chfl = 'CHAINE' 'FORMAT' fman man 'E' elfl ;
  1341. 'SINON' ;
  1342. chfl = 'CHAINE' 'FORMAT' fman man ;
  1343. 'FINSI' ;
  1344. 'SINON' ;
  1345. man2 = 'ENTIER' ('+' man ('*' 0.5D0 sman)) ;
  1346. 'SI' ('NEG' elfl 0) ;
  1347. chfl = 'CHAINE' man2 'E' elfl ;
  1348. 'SINON' ;
  1349. chfl = 'CHAINE' man2 ;
  1350. 'FINSI' ;
  1351. 'FINSI' ;
  1352. 'FINSI' ;
  1353. 'RESPRO' chfl ;
  1354. *
  1355. * End of procedure file FORMAR
  1356. *
  1357. 'FINPROC' ;
  1358. *ENDPROCEDUR formar
  1359. *BEGINPROCEDUR gchpo
  1360. ************************************************************************
  1361. * NOM : GCHPO
  1362. * DESCRIPTION : Une matrice de masse
  1363. *
  1364. *
  1365. *
  1366. * LANGAGE : GIBIANE-CAST3M
  1367. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1368. * mél : gounand@semt2.smts.cea.fr
  1369. **********************************************************************
  1370. * VERSION : v2, 14/03/2006, mise à jour NLIN évolué
  1371. * VERSION : v1, 13/05/2004, version initiale
  1372. * HISTORIQUE : v1, 13/05/2004, création
  1373. * HISTORIQUE :
  1374. * HISTORIQUE :
  1375. ************************************************************************
  1376. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1377. * en cas de modification de ce sous-programme afin de faciliter
  1378. * la maintenance !
  1379. ************************************************************************
  1380. *
  1381. *
  1382. 'DEBPROC' GCHPO ;
  1383. 'ARGUMENT' _mt*'MAILLAGE' ;
  1384. 'ARGUMENT' nomq*'MOT ' ;
  1385. 'ARGUMENT' coef*'FLOTTANT' ;
  1386. *
  1387. 'SI' ('EGA' discq 'LINM') ;
  1388. discq = 'CSTE' ;
  1389. 'FINSI' ;
  1390. *
  1391. idim = DEADUTIL 'DIMM' _mt ;
  1392. vdim = 'VALEUR' 'DIME' ;
  1393. *
  1394. discg = TDISC . 'GEOM' . 'DISC' ;
  1395. tnomq = TDISC . nomq ;
  1396. *
  1397. ms = tnomq . 'NOMINC' . 1 ;
  1398. numop = 1 ; numder = idim ; numvar = 1 ; numdat = 0 ; numcof = 0 ;
  1399. A = ININLIN numop numvar numdat numcof numder ;
  1400. A . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
  1401. A . 'VAR' . 1 . 'DISC' = 'CSTE' ;
  1402. A . 'VAR' . 1 . 'VALEUR' = 0. ;
  1403. *
  1404. A . 1 . 1 . 0 = 'LECT' ;
  1405. *
  1406. B = ININLIN numop numvar numdat numcof numder ;
  1407. B . 'VAR' . 1 . 'NOMDDL' = ms ;
  1408. B . 'VAR' . 1 . 'DISC' = tnomq . 'DISC' ;
  1409. *
  1410. B . 1 . 1 . 0 = 'LECT' ;
  1411. *
  1412. mgchpos = '+' (NLIN discg _mt A B 'ERF1' 'GAU7') coef ;
  1413. *
  1414. mgchpo = 'NOMC' ms (tnomq . 'NOMINC' . 1) mgchpos ;
  1415. *
  1416. ninc = 'DIME' (tnomq . 'NOMINC') ;
  1417. 'SI' ('>' ninc 1) ;
  1418. 'REPETER' iinc ('-' ninc 1) ;
  1419. mgchpo = '+' mgchpo
  1420. ('NOMC' ms (tnomq . 'NOMINC' . ('+' &iinc 1)) mgchpos) ;
  1421. 'FIN' iinc ;
  1422. 'FINSI' ;
  1423. *
  1424. 'RESPRO' mgchpo ;
  1425. 'FINPROC' ;
  1426. *
  1427. * End of procedure file GCHPO
  1428. *
  1429. *ENDPROCEDUR gchpo
  1430. *BEGINPROCEDUR gdiv2
  1431. ************************************************************************
  1432. * NOM : GDIV2
  1433. * DESCRIPTION : Une matrice de masse
  1434. *
  1435. *
  1436. *
  1437. * LANGAGE : GIBIANE-CAST3M
  1438. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1439. * mél : gounand@semt2.smts.cea.fr
  1440. **********************************************************************
  1441. * VERSION : v2, 14/03/2006, mise à jour NLIN évolué
  1442. * VERSION : v1, 13/05/2004, version initiale
  1443. * HISTORIQUE : v1, 13/05/2004, création
  1444. * HISTORIQUE :
  1445. * HISTORIQUE :
  1446. ************************************************************************
  1447. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1448. * en cas de modification de ce sous-programme afin de faciliter
  1449. * la maintenance !
  1450. ************************************************************************
  1451. *
  1452. *
  1453. 'DEBPROC' GDIV2 ;
  1454. 'ARGUMENT' _mt*'MAILLAGE' ;
  1455. 'ARGUMENT' _smt/'MAILLAGE' ;
  1456. 'ARGUMENT' tdisc*'TABLE' ;
  1457. *
  1458. * Lectures
  1459. *
  1460. debug = FAUX ;
  1461. lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
  1462. 'NCOF' 'FCOF' 'CCOF' 'GBBT' 'GMBT' ;
  1463. * Il faut initialiser valt et valq, sinon on peut capturer ceux de
  1464. * la procédure appelante
  1465. valt = 'valt' ; valq = 'valq' ;
  1466. lbbt = 0 ;
  1467. *
  1468. 'REPETER' imotcle ;
  1469. 'ARGUMENT' motcle/'MOT' ;
  1470. 'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
  1471. 'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
  1472. cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
  1473. 'FINSI' ;
  1474. 'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
  1475. 'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
  1476. 'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
  1477. 'SI' ('EGA' motcle 'FPRI') ; 'ARGUMENT' valt*'LISTREEL' ; 'FINSI' ;
  1478. 'SI' ('EGA' motcle 'FDUA') ; 'ARGUMENT' valq*'FLOTTANT' ; 'FINSI' ;
  1479. 'SI' ('EGA' motcle 'FCOF') ; 'ARGUMENT' valo*'FLOTTANT' ; 'FINSI' ;
  1480. 'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
  1481. 'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
  1482. 'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
  1483. 'SI' ('EGA' motcle 'GBBT') ; lbbt = 1 ; 'FINSI' ;
  1484. 'SI' ('EGA' motcle 'GMBT') ; lbbt = 2 ; 'FINSI' ;
  1485. 'FIN' imotcle ;
  1486. *
  1487. * Tests
  1488. *
  1489. discg = TDISC . 'GEOM' . 'DISC' ;
  1490. 'SI' ('EXISTE' tdisc 'methgau') ;
  1491. methgau = tdisc . 'methgau' . 'amor' ;
  1492. 'SINON' ;
  1493. methgau = 'GAU7' ;
  1494. 'FINSI' ;
  1495. tnomt = TDISC . nomt ;
  1496. lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
  1497. tnomq = TDISC . nomq ;
  1498. lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
  1499. *
  1500. lcof = 'EXISTE' TDISC nomo ;
  1501. 'SI' lcof ; ncof = 1 ; tcof = TDISC . nomo ;
  1502. 'SINON' ; ncof = 0 ;
  1503. 'FINSI' ;
  1504. *
  1505. 'SI' debug ;
  1506. 'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
  1507. 'SINON' ; 'MESSAGE' 'pas de coef detecte' ;
  1508. 'FINSI' ;
  1509. 'FINSI' ;
  1510. *
  1511. vdim = 'VALEUR' 'DIME' ;
  1512. vmod = 'VALEUR' 'MODE' ;
  1513. idim = 0 ;
  1514. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  1515. idim = 2 ;
  1516. iaxi = FAUX ;
  1517. 'FINSI' ;
  1518. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  1519. idim = 2 ;
  1520. iaxi = VRAI ;
  1521. 'FINSI' ;
  1522. 'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  1523. idim = 3 ;
  1524. iaxi = FAUX ;
  1525. 'FINSI' ;
  1526. 'SI' ('EGA' vdim 1) ;
  1527. idim = 1 ;
  1528. iaxi = FAUX ;
  1529. 'FINSI' ;
  1530. 'SI' ('EGA' idim 0) ;
  1531. 'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  1532. 'FINSI' ;
  1533. 'SI' iaxi ;
  1534. dp = ('*' PI 2.D0) ;
  1535. rmt = 'COORDONNEE' 1 _mt ;
  1536. ncof = ncof '+' 2 ;
  1537. 'FINSI' ;
  1538. * Scalaire ou vecteur
  1539. ninct = 'DIME' (tnomt . 'NOMINC') ;
  1540. nincq = 'DIME' (tnomq . 'NOMINC') ;
  1541. 'SI' ('NEG' ninct idim) ;
  1542. cherr = 'CHAINE'
  1543. 'la primale doit etre un vecteur' ;
  1544. 'ERREUR' cherr ;
  1545. 'FINSI' ;
  1546. 'SI' ('NEG' nincq 1) ;
  1547. cherr = 'CHAINE'
  1548. 'la duale doit etre un scalaire' ;
  1549. 'ERREUR' cherr ;
  1550. 'FINSI' ;
  1551. *
  1552. numop = 1 ; numder = idim ; numvar = ninct ;
  1553. numdat = ncof ; numcof = ncof ;
  1554. A = ININLIN numop numvar numdat numcof numder ;
  1555. *
  1556. lvt = 'EGA' ('TYPE' valt) 'LISTREEL' ;
  1557. 'REPETER' iiinct ninct ;
  1558. iinct = &iiinct ;
  1559. A . 'VAR' . iinct . 'NOMDDL' = tnomt . 'NOMINC' . iinct ;
  1560. A . 'VAR' . iinct . 'DISC' = tnomt . 'DISC' ;
  1561. 'SI' lvalt ;
  1562. 'SI' lvt ;
  1563. A . 'VAR' . iinct . 'VALEUR' = 'EXTRAIRE' valt iinct ;
  1564. 'SINON' ;
  1565. A . 'VAR' . iinct . 'VALEUR' = valt ;
  1566. 'FINSI' ;
  1567. 'FINSI' ;
  1568. 'FIN' iiinct ;
  1569. *
  1570. icof = 0 ;
  1571. 'SI' lcof ;
  1572. icof = '+' icof 1 ;
  1573. A . 'DAT' . icof . 'NOMDDL' = tcof . 'NOMINC' . 1 ;
  1574. A . 'DAT' . icof . 'DISC' = tcof . 'DISC' ;
  1575. A . 'DAT' . icof . 'VALEUR' = valo ;
  1576. A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  1577. A . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  1578. ll = 'LECT' 1 ;
  1579. 'SINON' ;
  1580. ll = 'LECT' ;
  1581. 'FINSI' ;
  1582. *
  1583. 'SI' iaxi ;
  1584. icof = '+' icof 1 ;
  1585. A . 'DAT' . icof . 'NOMDDL' = 'MOTS' 'SCAL' ;
  1586. A . 'DAT' . icof . 'DISC' = 'CSTE' ;
  1587. A . 'DAT' . icof . 'VALEUR' = dp ;
  1588. A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  1589. A . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  1590. icof = '+' icof 1 ;
  1591. A . 'DAT' . icof . 'NOMDDL' = 'MOTS' 'SCAL' ;
  1592. A . 'DAT' . icof . 'DISC' = discg ;
  1593. A . 'DAT' . icof . 'VALEUR' = rmt ;
  1594. A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  1595. A . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  1596. lldpr = ll 'ET' ('LECT' ('-' icof 1) icof) ;
  1597. lldp = ll 'ET' ('LECT' ('-' icof 1)) ;
  1598. 'FINSI' ;
  1599. *
  1600. 'SI' iaxi ;
  1601. 'REPETER' iidim idim ;
  1602. A . 1 . &iidim . &iidim = lldpr ;
  1603. 'FIN' iidim ;
  1604. A . 1 . 1 . 0 = lldp ;
  1605. 'SINON' ;
  1606. 'REPETER' iidim idim ;
  1607. A . 1 . &iidim . &iidim = ll ;
  1608. 'FIN' iidim ;
  1609. 'FINSI' ;
  1610. *
  1611. numvar = 1 ;
  1612. numdat = 0 ;
  1613. numcof = 0 ;
  1614. *
  1615. B = ININLIN numop numvar numdat numcof numder ;
  1616. B . 'VAR' . 1 . 'NOMDDL' = tnomq . 'NOMINC' . 1 ;
  1617. B . 'VAR' . 1 . 'DISC' = tnomq . 'DISC' ;
  1618. 'SI' lvalq ;
  1619. B . 'VAR' . 1 . 'VALEUR' = valq ;
  1620. 'FINSI' ;
  1621. B . 1 . 1 . 0 = 'LECT' ;
  1622. *
  1623. 'SI' ('OU' ('EGA' lbbt 0) ('EGA' lbbt 1)) ;
  1624. 'SI' ('EXISTE' _smt) ;
  1625. mgdiv2 = 'NLIN' discg _mt _smt A B methgau ;
  1626. 'SINON' ;
  1627. mgdiv2 = NLINP discg _mt A B methgau ;
  1628. 'FINSI' ;
  1629. 'SI' ('EGA' lbbt 1) ;
  1630. 'SI' ('EXISTE' _smt) ;
  1631. mgdiv3 = 'NLIN' discg _mt _smt B A methgau ;
  1632. 'SINON' ;
  1633. mgdiv3 = NLINP discg _mt B A methgau ;
  1634. 'FINSI' ;
  1635. mgdiv2 = 'ET' mgdiv2 mgdiv3 ;
  1636. 'FINSI' ;
  1637. 'FINSI' ;
  1638. 'SI' ('EGA' lbbt 2) ;
  1639. 'SI' ('EXISTE' _smt) ;
  1640. mgdiv2 = 'NLIN' discg _mt _smt B A methgau ;
  1641. 'SINON' ;
  1642. mgdiv2 = NLINP discg _mt B A methgau ;
  1643. 'FINSI' ;
  1644. 'FINSI' ;
  1645. *
  1646. 'RESPRO' mgdiv2 ;
  1647. 'FINPROC' ;
  1648. *
  1649. * End of procedure file GDIV2
  1650. *
  1651. *ENDPROCEDUR gdiv2
  1652. *BEGINPROCEDUR getcoo
  1653. ************************************************************************
  1654. * NOM : GETCOO
  1655. * DESCRIPTION :
  1656. * Renvoie les coordonnées des points dans un champ type déplacement
  1657. *
  1658. *
  1659. *
  1660. * LANGAGE : GIBIANE-CAST3M
  1661. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1662. * mél : gounand@semt2.smts.cea.fr
  1663. **********************************************************************
  1664. * VERSION : v1, 22/04/2011, version initiale
  1665. * HISTORIQUE : v1, 22/04/2011, création
  1666. * HISTORIQUE :
  1667. * HISTORIQUE :
  1668. ************************************************************************
  1669. *
  1670. *
  1671. 'DEBPROC' GETCOO ;
  1672. 'ARGUMENT' mail*'MAILLAGE' ;
  1673. 'ARGUMENT' incop*'LISTMOTS' ;
  1674. *
  1675. dim = 'VALEUR' 'DIME' ;
  1676. 'REPETER' iidim dim ;
  1677. idim= &iidim ;
  1678. icoo = 'NOMC' ('EXTRAIRE' incop idim)
  1679. ('COORDONNEE' idim mail) ;
  1680. 'SI' ('EGA' idim 1) ;
  1681. vcoo = icoo ;
  1682. 'SINON' ;
  1683. vcoo = 'ET' vcoo icoo ;
  1684. 'FINSI' ;
  1685. 'FIN' iidim ;
  1686. 'RESPRO' vcoo ;
  1687. *
  1688. * End of procedure file GETCOO
  1689. *
  1690. 'FINPROC' ;
  1691. *ENDPROCEDUR getcoo
  1692. *BEGINPROCEDUR gforc
  1693. ************************************************************************
  1694. * NOM : GFORC
  1695. * DESCRIPTION : Calcul de la force associée à une pression imposée
  1696. *
  1697. *
  1698. *
  1699. * LANGAGE : GIBIANE-CAST3M
  1700. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1701. * mél : gounand@semt2.smts.cea.fr
  1702. **********************************************************************
  1703. * VERSION : v1, ??/??/2007, version initiale
  1704. * HISTORIQUE : v1, ??/??/2007, création
  1705. * HISTORIQUE :
  1706. * HISTORIQUE :
  1707. ************************************************************************
  1708. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1709. * en cas de modification de ce sous-programme afin de faciliter
  1710. * la maintenance !
  1711. ************************************************************************
  1712. *
  1713. *
  1714. 'DEBPROC' GFORC ;
  1715. 'ARGUMENT' _surf*'MAILLAGE' ;
  1716. 'ARGUMENT' tdisc*'TABLE' ;
  1717. 'ARGUMENT' pfor*'CHPOINT' ;
  1718. *
  1719. vdim = 'VALEUR' 'DIME' ;
  1720. DISCG = TDISC . 'GEOM' . 'DISC' ;
  1721. fpfor = GNOR _surf tdisc 'NPRI' discg 'CPRI' pfor 'NDUA' 'XN' ;
  1722. 'RESPRO' fpfor ;
  1723. *
  1724. * End of procedure file GFORC
  1725. *
  1726. 'FINPROC' ;
  1727. *ENDPROCEDUR gforc
  1728. *BEGINPROCEDUR ggravi
  1729. ************************************************************************
  1730. * NOM : GGRAVI
  1731. * DESCRIPTION : Calcul de la force associée au potentiel gravitaire
  1732. * (\rho g z si g vertical)
  1733. *
  1734. *
  1735. *
  1736. * LANGAGE : GIBIANE-CAST3M
  1737. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1738. * mél : gounand@semt2.smts.cea.fr
  1739. **********************************************************************
  1740. * VERSION : v1, 22/04/2011
  1741. * HISTORIQUE : v1, 22/04/2011, création
  1742. * HISTORIQUE :
  1743. * HISTORIQUE :
  1744. ************************************************************************
  1745. *
  1746. *
  1747. 'DEBPROC' GGRAVI ;
  1748. 'ARGUMENT' _surf*'MAILLAGE' ;
  1749. 'ARGUMENT' tdisc*'TABLE' ;
  1750. 'ARGUMENT' coef*'FLOTTANT' ;
  1751. 'ARGUMENT' ang*'FLOTTANT' ;
  1752. *
  1753. vdim = 'VALEUR' 'DIME' ;
  1754. pgrax = '*' ('COORDONNEE' 1 _surf) ('*' +1. ('SIN' ang)) ;
  1755. pgraz = '*' ('COORDONNEE' vdim _surf) ('*' -1. ('COS' ang)) ;
  1756. DISCG = TDISC . 'GEOM' . 'DISC' ;
  1757. fpgrax = GNOR _surf tdisc 'NPRI' discg 'CPRI' pgrax 'NDUA' 'XN' ;
  1758. fpgraz = GNOR _surf tdisc 'NPRI' discg 'CPRI' pgraz 'NDUA' 'XN' ;
  1759. fpgra = '+' fpgrax fpgraz ;
  1760. fpgra = '*' fpgra ('*' -1. coef) ;
  1761. 'RESPRO' fpgra ;
  1762. *
  1763. * End of procedure file GGRAVI
  1764. *
  1765. 'FINPROC' ;
  1766. *ENDPROCEDUR ggravi
  1767. *BEGINPROCEDUR gkforc
  1768. ************************************************************************
  1769. * NOM : GKFORC
  1770. * DESCRIPTION : Calcul de la matrice tangente associée à la force
  1771. * de pression imposée. Cette matrice tangente est
  1772. * partielle car elle ne prend en compte que le gradient
  1773. * surfacique de pression. On peut difficilement
  1774. * faire autrement si on ne considère que la surface.
  1775. *
  1776. *
  1777. * LANGAGE : GIBIANE-CAST3M
  1778. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1779. * mél : gounand@semt2.smts.cea.fr
  1780. **********************************************************************
  1781. * VERSION : v1, ??/??/2007, version initiale
  1782. * HISTORIQUE : v1, ??/??/2007, création
  1783. * HISTORIQUE :
  1784. * HISTORIQUE :
  1785. ************************************************************************
  1786. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1787. * en cas de modification de ce sous-programme afin de faciliter
  1788. * la maintenance !
  1789. ************************************************************************
  1790. *
  1791. *
  1792. 'DEBPROC' GKFORC ;
  1793. 'ARGUMENT' _surf*'MAILLAGE' ;
  1794. 'ARGUMENT' tdisc*'TABLE' ;
  1795. 'ARGUMENT' pfor*'CHPOINT' ;
  1796. 'ARGUMENT' ijaco/'ENTIER' ;
  1797. 'SI' ('NON' ('EXISTE' ijaco)) ;
  1798. ijaco = 0 ;
  1799. 'FINSI' ;
  1800. vdim = 'VALEUR' 'DIME' ;
  1801. DISCG = TDISC . 'GEOM' . 'DISC' ;
  1802. *fpfor = GNOR _surf tdisc 'NPRI' discg 'CPRI' pfor 'NDUA' 'XN' ;
  1803. k1 = GNORGC _surf tdisc 'NPRI' 'XN'
  1804. 'NCOF' discg 'CCOF' pfor
  1805. 'NDUA' 'XN' ;
  1806. * k1 = GNOR _surf tdisc 'NPRI' discg 'NDUA' 'XN' ;
  1807. * k1 = '*' k1 -1. ;
  1808. * k1 = 'CHANGER' 'INCO' k1 ('MOTS' 'SCAL')
  1809. * ('MOTS' ('EXTRAIRE' NOMVIT vdim)) NOMVIT NOMVIT ;
  1810. k2 = GNORKTAN _surf tdisc 'NPRI' 'XN'
  1811. 'NCOF' discg 'CCOF' pfor 'NDUA' 'XN' ;
  1812. 'SI' ('OU' ('EGA' ijaco 0) ('EGA' ijaco 3)) ;
  1813. ktfor = k1 'ET' k2 ;
  1814. 'FINSI' ;
  1815. 'SI' ('EGA' ijaco 1) ;
  1816. ktfor = k1 ;
  1817. 'FINSI' ;
  1818. 'SI' ('EGA' ijaco 2) ;
  1819. ktfor = k2 ;
  1820. 'FINSI' ;
  1821. ktfor = '*' ktfor -1. ;
  1822. 'RESPRO' ktfor ;
  1823. *
  1824. * End of procedure file GKFORC
  1825. *
  1826. 'FINPROC' ;
  1827. *ENDPROCEDUR gkforc
  1828. *BEGINPROCEDUR gkgravi
  1829. ************************************************************************
  1830. * NOM : GKGRAVI
  1831. * DESCRIPTION : Calcul de la matrice tangente de la force
  1832. * associée au potentiel gravitaire (calculée par GGRAVI)
  1833. * en fonction des déplacements des points de la surface.
  1834. *
  1835. *
  1836. *
  1837. * LANGAGE : GIBIANE-CAST3M
  1838. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1839. * mél : gounand@semt2.smts.cea.fr
  1840. **********************************************************************
  1841. * VERSION : v1, 22/04/2011
  1842. * HISTORIQUE : v1, 22/04/2011, création
  1843. * HISTORIQUE :
  1844. * HISTORIQUE :
  1845. ************************************************************************
  1846. *
  1847. *
  1848. 'DEBPROC' GKGRAVI ;
  1849. 'ARGUMENT' _surf*'MAILLAGE' ;
  1850. 'ARGUMENT' tdisc*'TABLE' ;
  1851. 'ARGUMENT' ijaco*'ENTIER' ;
  1852. *'SI' ('NON' ('EXISTE' ijaco)) ;
  1853. * ijaco = 0 ;
  1854. *'FINSI' ;
  1855. 'ARGUMENT' coef*'FLOTTANT' ;
  1856. 'ARGUMENT' ang*'FLOTTANT' ;
  1857. *
  1858. vdim = 'VALEUR' 'DIME' ;
  1859. pgrax = '*' ('COORDONNEE' 1 _surf) ('*' +1. ('SIN' ang)) ;
  1860. pgraz = '*' ('COORDONNEE' vdim _surf) ('*' -1. ('COS' ang)) ;
  1861. *pgra = '*' ('-' ('COORDONNEE' vdim _surf) H) -1. ;
  1862. *pgra = '*' ('COORDONNEE' vdim _surf) -1. ;
  1863. DISCG = TDISC . 'GEOM' . 'DISC' ;
  1864. NOMDEP = @STBL (TDISC . 'XN' . 'NOMINC') ;
  1865. *fpgra = GNOR _surf tdisc 'NPRI' discg 'CPRI' pgra 'NDUA' 'XN' ;
  1866. k1x = GNOR _surf tdisc 'NPRI' discg 'NDUA' 'XN' ;
  1867. k1x = '*' k1x ('*' +1. ('SIN' ang)) ;
  1868. k1x = 'CHANGER' 'INCO' k1x ('MOTS' 'SCAL')
  1869. ('MOTS' ('EXTRAIRE' NOMDEP 1)) NOMDEP NOMDEP ;
  1870. k2x = GNORKTAN _surf tdisc 'NPRI' 'XN'
  1871. 'NCOF' discg 'CCOF' pgrax 'NDUA' 'XN' ;
  1872. k1z = GNOR _surf tdisc 'NPRI' discg 'NDUA' 'XN' ;
  1873. k1z = '*' k1z ('*' -1. ('COS' ang)) ;
  1874. k1z = 'CHANGER' 'INCO' k1z ('MOTS' 'SCAL')
  1875. ('MOTS' ('EXTRAIRE' NOMDEP vdim)) NOMDEP NOMDEP ;
  1876. k2z = GNORKTAN _surf tdisc 'NPRI' 'XN'
  1877. 'NCOF' discg 'CCOF' pgraz 'NDUA' 'XN' ;
  1878. 'SI' ('EGA' ijaco 0) ;
  1879. ktgra = k1x 'ET' k1z 'ET' k2x 'ET' k2z ;
  1880. 'FINSI' ;
  1881. 'SI' ('EGA' ijaco 1) ;
  1882. ktgra = k1x 'ET' k1z ;
  1883. 'FINSI' ;
  1884. 'SI' ('EGA' ijaco 2) ;
  1885. ktgra = k2x 'ET' k2z ;
  1886. 'FINSI' ;
  1887. ktgra = '*' ktgra coef ;
  1888. 'RESPRO' ktgra ;
  1889. *
  1890. * End of procedure file GKGRAVI
  1891. *
  1892. 'FINPROC' ;
  1893. *ENDPROCEDUR gkgravi
  1894. *BEGINPROCEDUR gkvol
  1895. ************************************************************************
  1896. * NOM : GKVOL
  1897. * DESCRIPTION : Matrice tangente associée à la variation du volume
  1898. * contenu dans une surface (calculé par GVOL)
  1899. * en fonction des déplacements des points de la surface.
  1900. *
  1901. *
  1902. * LANGAGE : GIBIANE-CAST3M
  1903. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1904. * mél : gounand@semt2.smts.cea.fr
  1905. **********************************************************************
  1906. * VERSION : v1, 22/04/2011, version initiale
  1907. * HISTORIQUE : v1, 22/04/2011, création
  1908. * HISTORIQUE :
  1909. * HISTORIQUE :
  1910. ************************************************************************
  1911. *
  1912. *
  1913. 'DEBPROC' GKVOL ;
  1914. 'ARGUMENT' _surf*'MAILLAGE' ;
  1915. 'ARGUMENT' tdisc*'TABLE' ;
  1916. 'ARGUMENT' ijaco/'ENTIER' ;
  1917. 'SI' ('NON' ('EXISTE' ijaco)) ;
  1918. ijaco = 0 ;
  1919. 'FINSI' ;
  1920. * Vecteur position et calcul du volume
  1921. NOMVIT = @STBL (TDISC . 'XN' . 'NOMINC') ;
  1922. DISCG = TDISC . 'GEOM' . 'DISC' ;
  1923. vdim = 'VALEUR' 'DIME' ;
  1924. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  1925. fdim = 3 ;
  1926. 'SINON' ;
  1927. fdim = vdim ;
  1928. 'FINSI' ;
  1929. vpos = GETCOO _surf nomvit ;
  1930. kvol1 = GNOR _surf tdisc 'NPRI' ('CHAINE' discg 'V')
  1931. 'NDUA' 'XN' 'FDUA' ('PROG' vdim * 1.) ;
  1932. kvol2 = GNORKTAN _surf tdisc 'NPRI' ('CHAINE' discg 'V')
  1933. 'NCOF' ('CHAINE' discg 'V') 'CCOF' vpos
  1934. 'NDUA' 'XN' 'FDUA' ('PROG' vdim * 1.) ;
  1935. 'SI' ('EGA' ijaco 0) ;
  1936. kvol = '/' ('+' kvol1 kvol2) fdim ;
  1937. 'FINSI' ;
  1938. 'SI' ('EGA' ijaco 1) ;
  1939. kvol = '/' kvol1 fdim ;
  1940. 'FINSI' ;
  1941. 'SI' ('EGA' ijaco 2) ;
  1942. kvol = '/' kvol2 fdim ;
  1943. 'FINSI' ;
  1944. 'RESPRO' kvol ;
  1945. *
  1946. * End of procedure file GKVOL
  1947. *
  1948. 'FINPROC' ;
  1949. *ENDPROCEDUR gkvol
  1950. *BEGINPROCEDUR gmail
  1951. ************************************************************************
  1952. * NOM : GMAIL
  1953. * DESCRIPTION : Une matrice de masse
  1954. *
  1955. *
  1956. *
  1957. * LANGAGE : GIBIANE-CAST3M
  1958. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1959. * mél : gounand@semt2.smts.cea.fr
  1960. **********************************************************************
  1961. * VERSION : v2, 14/03/2006, mise à jour NLIN évolué
  1962. * VERSION : v1, 13/05/2004, version initiale
  1963. * HISTORIQUE : v1, 13/05/2004, création
  1964. * HISTORIQUE :
  1965. * HISTORIQUE :
  1966. ************************************************************************
  1967. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1968. * en cas de modification de ce sous-programme afin de faciliter
  1969. * la maintenance !
  1970. ************************************************************************
  1971. *
  1972. *
  1973. 'DEBPROC' GMAIL ;
  1974. 'ARGUMENT' _mt*'MAILLAGE' ;
  1975. 'ARGUMENT' nomq*'MOT ' ;
  1976. *
  1977. gm = GCHPO _mt nomq 1. ;
  1978. dom = 'EXTRAIRE' gm 'MAIL' ;
  1979. *
  1980. 'RESPRO' dom ;
  1981. 'FINPROC' ;
  1982. *
  1983. * End of procedure file GMAIL
  1984. *
  1985. *ENDPROCEDUR gmail
  1986. *BEGINPROCEDUR gmass2
  1987. ************************************************************************
  1988. * NOM : GMASS2
  1989. * DESCRIPTION : Une matrice de masse
  1990. *
  1991. *
  1992. *
  1993. * LANGAGE : GIBIANE-CAST3M
  1994. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1995. * mél : gounand@semt2.smts.cea.fr
  1996. **********************************************************************
  1997. * VERSION : v2, 14/03/2006, mise à jour NLIN évolué
  1998. * VERSION : v1, 13/05/2004, version initiale
  1999. * HISTORIQUE : v1, 13/05/2004, création
  2000. * HISTORIQUE :
  2001. * HISTORIQUE :
  2002. ************************************************************************
  2003. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  2004. * en cas de modification de ce sous-programme afin de faciliter
  2005. * la maintenance !
  2006. ************************************************************************
  2007. *
  2008. *
  2009. 'DEBPROC' GMASS2 ;
  2010. 'ARGUMENT' _mt*'MAILLAGE' ;
  2011. 'ARGUMENT' _smt/'MAILLAGE' ;
  2012. 'ARGUMENT' tdisc*'TABLE' ;
  2013. *
  2014. * Lectures
  2015. *
  2016. debug = FAUX ;
  2017. lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
  2018. 'NCOF' 'FCOF' 'CCOF' ;
  2019. * Il faut initialiser valt et valq, sinon on peut capturer ceux de
  2020. * la procédure appelante
  2021. valt = 'valt' ; valq = 'valq' ;
  2022. 'REPETER' imotcle ;
  2023. 'ARGUMENT' motcle/'MOT' ;
  2024. 'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
  2025. 'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
  2026. cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
  2027. 'FINSI' ;
  2028. 'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
  2029. 'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
  2030. 'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
  2031. tst1 = 'EGA' motcle 'FPRI' ; tst2 = 'EGA' motcle 'FDUA' ;
  2032. tst = tst1 'OU' tst2 ;
  2033. 'SI' tst ;
  2034. 'SI' tst1 ; tt = TDISC . nomt ; 'FINSI' ;
  2035. 'SI' tst2 ; tt = TDISC . nomq ; 'FINSI' ;
  2036. isvec = ('>' ('DIME' (tt. 'NOMINC')) 1) ;
  2037. 'SI' isvec ; 'ARGUMENT' valv*'LISTREEL' ; 'SINON' ;
  2038. 'ARGUMENT' valv*'FLOTTANT' ;
  2039. 'FINSI' ;
  2040. 'SI' tst1 ; valt = valv ; 'FINSI' ;
  2041. 'SI' tst2 ; valq = valv ; 'FINSI' ;
  2042. 'FINSI' ;
  2043. 'SI' ('EGA' motcle 'FCOF') ; 'ARGUMENT' valo*'FLOTTANT' ; 'FINSI' ;
  2044. 'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
  2045. 'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
  2046. 'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
  2047. 'FIN' imotcle ;
  2048. *
  2049. * Tests
  2050. *
  2051. discg = TDISC . 'GEOM' . 'DISC' ;
  2052. 'SI' ('EXISTE' tdisc 'methgau') ;
  2053. methgau = tdisc . 'methgau' . 'mass' ;
  2054. 'SINON' ;
  2055. methgau = 'GAU7' ;
  2056. 'FINSI' ;
  2057. tnomt = TDISC . nomt ;
  2058. lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
  2059. tnomq = TDISC . nomq ;
  2060. lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
  2061. * Scalaire ou vecteur
  2062. ninct = 'DIME' (tnomt . 'NOMINC') ;
  2063. nincq = 'DIME' (tnomq . 'NOMINC') ;
  2064. 'SI' ('NEG' ninct nincq) ;
  2065. cherr = 'CHAINE'
  2066. 'les primales et duales nont pas le meme nombre de composantes' ;
  2067. 'ERREUR' cherr ;
  2068. 'FINSI' ;
  2069. ninc = ninct ;
  2070. *
  2071. lcof = 'EXISTE' TDISC nomo ;
  2072. 'SI' lcof ; ncof = 1 ; tcof = TDISC . nomo ;
  2073. 'SINON' ; ncof = 0 ;
  2074. 'FINSI' ;
  2075. *
  2076. 'SI' debug ;
  2077. 'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
  2078. 'SINON' ; 'MESSAGE' 'pas de coef detecte' ;
  2079. 'FINSI' ;
  2080. 'FINSI' ;
  2081. *
  2082. vdim = 'VALEUR' 'DIME' ;
  2083. vmod = 'VALEUR' 'MODE' ;
  2084. idim = 0 ;
  2085. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  2086. idim = 2 ;
  2087. iaxi = FAUX ;
  2088. 'FINSI' ;
  2089. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  2090. idim = 2 ;
  2091. iaxi = VRAI ;
  2092. 'FINSI' ;
  2093. 'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  2094. idim = 3 ;
  2095. iaxi = FAUX ;
  2096. 'FINSI' ;
  2097. 'SI' ('EGA' vdim 1) ;
  2098. idim = 1 ;
  2099. iaxi = FAUX ;
  2100. 'FINSI' ;
  2101. * 'MESSAGE' ('CHAINE' 'iaxi=' iaxi );
  2102. 'SI' ('EGA' idim 0) ;
  2103. 'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  2104. 'FINSI' ;
  2105. 'SI' iaxi ;
  2106. dprmt = '*' ('COORDONNEE' 1 _mt) ('*' PI 2.D0) ;
  2107. 'FINSI' ;
  2108. *
  2109. * Optimisation possible : construire la matrice par blocs
  2110. * qd valt et valq ne sont pas donnés
  2111. *
  2112. numop = ninc ; numder = idim ; numvar = ninc ;
  2113. numdat = ncof ; numcof = ncof ;
  2114. A = ININLIN numop numvar numdat numcof numder ;
  2115. 'SI' lcof ;
  2116. A . 'DAT' . 1 . 'NOMDDL' = tcof . 'NOMINC' . 1 ;
  2117. A . 'DAT' . 1 . 'DISC' = tcof . 'DISC' ;
  2118. A . 'DAT' . 1 . 'VALEUR' = valo ;
  2119. A . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  2120. A . 'COF' . 1 . 'LDAT' = 'LECT' 1 ;
  2121. ll = 'LECT' 1 ;
  2122. 'SINON' ;
  2123. ll = 'LECT' ;
  2124. 'FINSI' ;
  2125. lvt = 'EGA' ('TYPE' valt) 'LISTREEL' ;
  2126. 'REPETER' iiinc ninc ;
  2127. iinc = &iiinc ;
  2128. A . 'VAR' . iinc . 'NOMDDL' = tnomt . 'NOMINC' . iinc ;
  2129. A . 'VAR' . iinc . 'DISC' = tnomt . 'DISC' ;
  2130. 'SI' lvalt ;
  2131. 'SI' lvt ;
  2132. A . 'VAR' . iinc . 'VALEUR' = 'EXTRAIRE' valt iinc ;
  2133. 'SINON' ;
  2134. A . 'VAR' . iinc . 'VALEUR' = valt ;
  2135. 'FINSI' ;
  2136. 'FINSI' ;
  2137. A . iinc . iinc . 0 = ll ;
  2138. 'FIN' iiinc ;
  2139. *
  2140. 'SI' iaxi ;
  2141. numdat = 1 ;
  2142. numcof = 1 ;
  2143. 'SINON' ;
  2144. numdat = 0 ;
  2145. numcof = 0 ;
  2146. 'FINSI' ;
  2147. B = ININLIN numop numvar numdat numcof numder ;
  2148. 'SI' iaxi ;
  2149. B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  2150. B . 'DAT' . 1 . 'DISC' = discg ;
  2151. B . 'DAT' . 1 . 'VALEUR' = dprmt ;
  2152. B . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  2153. B . 'COF' . 1 . 'LDAT' = 'LECT' 1 ;
  2154. ll = 'LECT' 1 ;
  2155. 'SINON' ;
  2156. ll = 'LECT' ;
  2157. 'FINSI' ;
  2158. lvq = 'EGA' ('TYPE' valq) 'LISTREEL' ;
  2159. 'REPETER' iiinc ninc ;
  2160. iinc = &iiinc ;
  2161. B . 'VAR' . iinc . 'NOMDDL' = tnomq . 'NOMINC' . iinc ;
  2162. B . 'VAR' . iinc . 'DISC' = tnomq . 'DISC' ;
  2163. 'SI' lvalq ;
  2164. 'SI' lvq ;
  2165. B . 'VAR' . iinc . 'VALEUR' = 'EXTRAIRE' valq iinc ;
  2166. 'SINON' ;
  2167. B . 'VAR' . iinc . 'VALEUR' = valq ;
  2168. 'FINSI' ;
  2169. 'FINSI' ;
  2170. B . iinc . iinc . 0 = ll ;
  2171. 'FIN' iiinc ;
  2172. *
  2173. 'SI' ('EXISTE' _smt) ;
  2174. mgmass2 = 'NLIN' discg _mt _smt A B methgau ;
  2175. 'SINON' ;
  2176. mgmass2 = NLINP discg _mt A B methgau ;
  2177. 'FINSI' ;
  2178. *
  2179. 'RESPRO' mgmass2 ;
  2180. 'FINPROC' ;
  2181. *
  2182. * End of procedure file GMASS2
  2183. *
  2184. *ENDPROCEDUR gmass2
  2185. *BEGINPROCEDUR gnorgc
  2186. ************************************************************************
  2187. * NOM : GNORGC
  2188. * DESCRIPTION : Une matrice de masse
  2189. *
  2190. *
  2191. *
  2192. * LANGAGE : GIBIANE-CAST3M
  2193. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  2194. * mél : gounand@semt2.smts.cea.fr
  2195. **********************************************************************
  2196. * VERSION : v2, 14/03/2006, mise à jour NLIN évolué
  2197. * VERSION : v1, 13/05/2004, version initiale
  2198. * HISTORIQUE : v1, 13/05/2004, création
  2199. * HISTORIQUE :
  2200. * HISTORIQUE :
  2201. ************************************************************************
  2202. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  2203. * en cas de modification de ce sous-programme afin de faciliter
  2204. * la maintenance !
  2205. ************************************************************************
  2206. *
  2207. *
  2208. 'DEBPROC' GNORGC ;
  2209. 'ARGUMENT' _mt*'MAILLAGE' ;
  2210. 'ARGUMENT' tdisc*'TABLE' ;
  2211. *
  2212. * Lectures
  2213. *
  2214. vdim = 'VALEUR' 'DIME' ;
  2215. debug = FAUX ;
  2216. lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
  2217. 'NCOF' 'FCOF' 'CCOF' ;
  2218. * Il faut initialiser valt et valq, sinon on peut capturer ceux de
  2219. * la procédure appelante
  2220. valt = 'valt' ; valq = 'valq' ;
  2221. 'REPETER' imotcle ;
  2222. 'ARGUMENT' motcle/'MOT' ;
  2223. 'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
  2224. 'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
  2225. cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
  2226. 'FINSI' ;
  2227. 'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
  2228. 'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
  2229. 'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
  2230. tst1 = 'EGA' motcle 'FPRI' ; tst2 = 'EGA' motcle 'FDUA' ;
  2231. tst3 = 'EGA' motcle 'FCOF' ;
  2232. tst = tst1 'OU' tst2 'OU' tst3 ;
  2233. 'SI' tst ;
  2234. 'SI' tst1 ; tt = TDISC . nomt ; 'FINSI' ;
  2235. 'SI' tst2 ; tt = TDISC . nomq ; 'FINSI' ;
  2236. 'SI' tst3 ; tt = TDISC . nomo ; 'FINSI' ;
  2237. isvec = ('>' ('DIME' (tt. 'NOMINC')) 1) ;
  2238. 'SI' isvec ; 'ARGUMENT' valv*'LISTREEL' ; 'SINON' ;
  2239. 'ARGUMENT' valv*'FLOTTANT' ;
  2240. 'FINSI' ;
  2241. 'SI' tst1 ; valt = valv ; 'FINSI' ;
  2242. 'SI' tst2 ; valq = valv ; 'FINSI' ;
  2243. 'SI' tst3 ; valo = valv ; 'FINSI' ;
  2244. 'FINSI' ;
  2245. 'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
  2246. 'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
  2247. 'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
  2248. 'FIN' imotcle ;
  2249. *
  2250. * Tests
  2251. *
  2252. discg = TDISC . 'GEOM' . 'DISC' ;
  2253. 'SI' ('EXISTE' tdisc 'methgau') ;
  2254. methgau = tdisc . 'methgau' . 'mass' ;
  2255. 'SINON' ;
  2256. methgau = 'GAU7' ;
  2257. 'FINSI' ;
  2258. tnomt = TDISC . nomt ;
  2259. lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
  2260. tnomq = TDISC . nomq ;
  2261. lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
  2262. * Scalaire ou vecteur
  2263. ninct = 'DIME' (tnomt . 'NOMINC') ;
  2264. nincq = 'DIME' (tnomq . 'NOMINC') ;
  2265. 'SI' ('NEG' ninct vdim) ;
  2266. cherr = 'CHAINE'
  2267. 'la primale doit etre un vecteur' ;
  2268. 'ERREUR' cherr ;
  2269. 'FINSI' ;
  2270. 'SI' ('NEG' nincq vdim) ;
  2271. cherr = 'CHAINE'
  2272. 'la duale doit etre un vecteur' ;
  2273. 'ERREUR' cherr ;
  2274. 'FINSI' ;
  2275. *ninc = ninct ;
  2276. *
  2277. lcof = 'EXISTE' TDISC nomo ;
  2278. 'SI' lcof ; tcof = TDISC . nomo ;
  2279. ncof = 'DIME' (tcof . 'NOMINC') ;
  2280. 'SINON' ; ncof = 0 ;
  2281. 'FINSI' ;
  2282. 'SI' ('NEG' ncof 1) ;
  2283. cherr = 'CHAINE'
  2284. 'il faut un coefficient scalaire' ;
  2285. 'ERREUR' cherr ;
  2286. 'FINSI' ;
  2287. *
  2288. 'SI' debug ;
  2289. 'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
  2290. 'SINON' ; 'MESSAGE' 'pas de coef detecte' ;
  2291. 'FINSI' ;
  2292. 'FINSI' ;
  2293. *
  2294. vdim = 'VALEUR' 'DIME' ;
  2295. vmod = 'VALEUR' 'MODE' ;
  2296. idim = 0 ;
  2297. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  2298. idim = 2 ;
  2299. iaxi = FAUX ;
  2300. 'FINSI' ;
  2301. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  2302. idim = 2 ;
  2303. iaxi = VRAI ;
  2304. 'FINSI' ;
  2305. 'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  2306. idim = 3 ;
  2307. iaxi = FAUX ;
  2308. 'FINSI' ;
  2309. 'SI' ('EGA' vdim 1) ;
  2310. idim = 1 ;
  2311. iaxi = FAUX ;
  2312. 'FINSI' ;
  2313. * 'MESSAGE' ('CHAINE' 'iaxi=' iaxi );
  2314. 'SI' ('EGA' idim 0) ;
  2315. 'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  2316. 'FINSI' ;
  2317. 'SI' iaxi ;
  2318. dprmt = '*' ('COORDONNEE' 1 _mt) ('*' PI 2.D0) ;
  2319. 'FINSI' ;
  2320. *
  2321. * Optimisation possible : construire la matrice par blocs
  2322. * qd valt et valq ne sont pas donnés
  2323. *
  2324. numop = ninct '*' nincq ; numder = idim ; numvar = ninct ;
  2325. numdat = 1 ; numcof = idim ;
  2326. A = ININLIN numop numvar numdat numcof numder ;
  2327. A . 'DAT' . 1 . 'NOMDDL' = tcof . 'NOMINC' . 1 ;
  2328. A . 'DAT' . 1 . 'DISC' = tcof . 'DISC' ;
  2329. A . 'DAT' . 1 . 'VALEUR' = valo ;
  2330. 'REPETER' iicof numcof ;
  2331. icof = &iicof ;
  2332. A . 'COF' . icof . 'COMPOR' = 'CHAINE' 'D/DX' icof ;
  2333. A . 'COF' . icof . 'LDAT' = 'LECT' 1 ;
  2334. 'FIN' iicof ;
  2335. lvt = 'EGA' ('TYPE' valt) 'LISTREEL' ;
  2336. iop = 0 ;
  2337. 'REPETER' iiinct ninct ;
  2338. iinct = &iiinct ;
  2339. A . 'VAR' . iinct . 'NOMDDL' = tnomt . 'NOMINC' . iinct ;
  2340. A . 'VAR' . iinct . 'DISC' = tnomt . 'DISC' ;
  2341. 'SI' lvalt ;
  2342. 'SI' lvt ;
  2343. A . 'VAR' . iinct . 'VALEUR' = 'EXTRAIRE' valt iinct ;
  2344. 'SINON' ;
  2345. A . 'VAR' . iinct . 'VALEUR' = valt ;
  2346. 'FINSI' ;
  2347. 'FINSI' ;
  2348. ll = 'LECT' iinct ;
  2349. 'REPETER' iiincq nincq ;
  2350. iop = '+' iop 1 ;
  2351. A . iop . iinct . 0 = 'LECT' ;
  2352. * A . iop . iinct . 0 = ll ;
  2353. 'FIN' iiincq ;
  2354. 'FIN' iiinct ;
  2355. *
  2356. 'SI' iaxi ;
  2357. numdat = 1 ;
  2358. numcof = idim '+' 1 ;
  2359. 'SINON' ;
  2360. numdat = 0 ;
  2361. numcof = idim ;
  2362. 'FINSI' ;
  2363. numvar = nincq ;
  2364. B = ININLIN numop numvar numdat numcof numder ;
  2365. icof = 0 ;
  2366. 'REPETER' iiidim idim ;
  2367. icof = '+' icof 1 ;
  2368. B . 'COF' . icof . 'COMPOR' = 'CHAINE' 'VNOR' &iiidim ;
  2369. B . 'COF' . icof . 'LDAT' = 'LECT' ;
  2370. 'FIN' iiidim ;
  2371. *
  2372. 'SI' iaxi ;
  2373. icof = '+' icof 1 ;
  2374. B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  2375. B . 'DAT' . 1 . 'DISC' = discg ;
  2376. B . 'DAT' . 1 . 'VALEUR' = dprmt ;
  2377. B . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  2378. B . 'COF' . icof . 'LDAT' = 'LECT' 1 ;
  2379. ll = 'LECT' icof ;
  2380. 'SINON' ;
  2381. ll = 'LECT' ;
  2382. 'FINSI' ;
  2383. lvq = 'EGA' ('TYPE' valq) 'LISTREEL' ;
  2384. 'REPETER' iiincq nincq ;
  2385. iincq = &iiincq ;
  2386. B . 'VAR' . iincq . 'NOMDDL' = tnomq . 'NOMINC' . iincq ;
  2387. B . 'VAR' . iincq . 'DISC' = tnomq . 'DISC' ;
  2388. 'SI' lvalq ;
  2389. 'SI' lvq ;
  2390. B . 'VAR' . iincq . 'VALEUR' = 'EXTRAIRE' valq iincq ;
  2391. 'SINON' ;
  2392. B . 'VAR' . iincq . 'VALEUR' = valq ;
  2393. 'FINSI' ;
  2394. 'FINSI' ;
  2395. 'FIN' iiincq ;
  2396. iop = 0 ;
  2397. 'REPETER' iiinct ninct ;
  2398. * iinct = &iiinct ;
  2399. 'REPETER' iiincq nincq ;
  2400. iincq = &iiincq ;
  2401. iop = '+' iop 1 ;
  2402. B . iop . iincq . 0 = ('LECT' iincq) 'ET' ll ;
  2403. 'FIN' iiincq ;
  2404. 'FIN' iiinct ;
  2405. *
  2406. mgnorgc = NLIN discg _mt A B methgau ;
  2407. *
  2408. 'RESPRO' mgnorgc ;
  2409. 'FINPROC' ;
  2410. *
  2411. * End of procedure file GNORGC
  2412. *
  2413. *ENDPROCEDUR gnorgc
  2414. *BEGINPROCEDUR gnorktan
  2415. ************************************************************************
  2416. * NOM : GNORKTAN
  2417. * DESCRIPTION : Matrice tangente associée à la variation de la normale
  2418. * à une surface (calculée par GNOR)
  2419. * en fonction des déplacements des points de la surface.
  2420. *
  2421. *
  2422. *
  2423. * LANGAGE : GIBIANE-CAST3M
  2424. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  2425. * mél : gounand@semt2.smts.cea.fr
  2426. **********************************************************************
  2427. * VERSION : v1, 22/04/2011, version initiale
  2428. * HISTORIQUE : v1, 22/04/2011, création
  2429. * HISTORIQUE :
  2430. * HISTORIQUE :
  2431. ************************************************************************
  2432. *
  2433. *
  2434. 'DEBPROC' GNORKTAN ;
  2435. 'ARGUMENT' _mt*'MAILLAGE' ;
  2436. 'ARGUMENT' tdisc*'TABLE' ;
  2437. *
  2438. * Lectures
  2439. *
  2440. dim = 'VALEUR' 'DIME' ;
  2441. mdim = DEADUTIL 'DIMM' _mt ;
  2442. 'SI' ('NEG' mdim ('-' dim 1)) ;
  2443. 'ERREUR' 'Dim. maillage .neq. dim. espace - 1' ;
  2444. 'FINSI' ;
  2445. loi = 'CHAINE' 'VNOJ' ;
  2446. debug = FAUX ;
  2447. lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
  2448. 'NCOF' 'FCOF' 'CCOF' ;
  2449. * Il faut initialiser valt et valq, sinon on peut capturer ceux de
  2450. * la procédure appelante
  2451. valt = 'valt' ; valq = 'valq' ;
  2452. 'REPETER' imotcle ;
  2453. 'ARGUMENT' motcle/'MOT' ;
  2454. 'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
  2455. 'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
  2456. cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
  2457. 'FINSI' ;
  2458. 'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
  2459. 'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
  2460. 'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
  2461. tst1 = 'EGA' motcle 'FPRI' ; tst2 = 'EGA' motcle 'FDUA' ;
  2462. tst = tst1 'OU' tst2 ;
  2463. 'SI' tst ;
  2464. 'SI' tst1 ; tt = TDISC . nomt ; 'FINSI' ;
  2465. 'SI' tst2 ; tt = TDISC . nomq ; 'FINSI' ;
  2466. isvec = ('>' ('DIME' (tt. 'NOMINC')) 1) ;
  2467. 'SI' isvec ; 'ARGUMENT' valv*'LISTREEL' ; 'SINON' ;
  2468. 'ARGUMENT' valv*'FLOTTANT' ;
  2469. 'FINSI' ;
  2470. 'SI' tst1 ; valt = valv ; 'FINSI' ;
  2471. 'SI' tst2 ; valq = valv ; 'FINSI' ;
  2472. 'FINSI' ;
  2473. 'SI' ('EGA' motcle 'FCOF') ; 'ARGUMENT' valo*'FLOTTANT' ; 'FINSI' ;
  2474. 'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
  2475. 'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
  2476. 'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
  2477. 'FIN' imotcle ;
  2478. *
  2479. * Tests
  2480. *
  2481. discg = TDISC . 'GEOM' . 'DISC' ;
  2482. 'SI' ('EXISTE' tdisc 'methgau') ;
  2483. methgau = tdisc . 'methgau' . 'mass' ;
  2484. 'SINON' ;
  2485. methgau = 'GAU7' ;
  2486. 'FINSI' ;
  2487. tnomt = TDISC . nomt ;
  2488. lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
  2489. tnomq = TDISC . nomq ;
  2490. lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
  2491. * Scalaire ou vecteur
  2492. ninct = 'DIME' (tnomt . 'NOMINC') ;
  2493. nincq = 'DIME' (tnomq . 'NOMINC') ;
  2494. 'SI' ('NEG' ninct dim) ;
  2495. cherr = 'CHAINE'
  2496. 'la primale doit etre un vecteur' ;
  2497. 'ERREUR' cherr ;
  2498. 'FINSI' ;
  2499. 'SI' ('NEG' nincq dim) ;
  2500. cherr = 'CHAINE'
  2501. 'la duale doit etre un vecteur' ;
  2502. 'ERREUR' cherr ;
  2503. 'FINSI' ;
  2504. ninc = dim ;
  2505. *
  2506. lcof = 'EXISTE' TDISC nomo ;
  2507. 'SI' lcof ; tcof = TDISC . nomo ;
  2508. ncof = 'DIME' (tcof . 'NOMINC') ;
  2509. 'SINON' ; ncof = 0 ;
  2510. 'FINSI' ;
  2511. *
  2512. 'SI' debug ;
  2513. 'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
  2514. 'SINON' ; 'MESSAGE' 'pas de coef detecte' ;
  2515. 'FINSI' ;
  2516. 'FINSI' ;
  2517. *
  2518. vdim = 'VALEUR' 'DIME' ;
  2519. vmod = 'VALEUR' 'MODE' ;
  2520. idim = 0 ;
  2521. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  2522. idim = 2 ;
  2523. iaxi = FAUX ;
  2524. 'FINSI' ;
  2525. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  2526. idim = 2 ;
  2527. iaxi = VRAI ;
  2528. 'FINSI' ;
  2529. 'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  2530. idim = 3 ;
  2531. iaxi = FAUX ;
  2532. 'FINSI' ;
  2533. 'SI' ('EGA' vdim 1) ;
  2534. idim = 1 ;
  2535. iaxi = FAUX ;
  2536. 'FINSI' ;
  2537. * 'MESSAGE' ('CHAINE' 'iaxi=' iaxi );
  2538. 'SI' ('EGA' idim 0) ;
  2539. 'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  2540. 'FINSI' ;
  2541. 'SI' iaxi ;
  2542. deupi = '*' PI 2.D0 ;
  2543. dprmt = '*' ('COORDONNEE' 1 _mt) deupi ;
  2544. 'FINSI' ;
  2545. *
  2546. * Optimisation possible : construire la matrice par blocs
  2547. * qd valt et valq ne sont pas donnés
  2548. *
  2549. numop = idim '*' idim '*' idim ;
  2550. 'SI' iaxi ;
  2551. numop = numop '+' idim ;
  2552. 'FINSI' ;
  2553. numder = idim ; numvar = ninct ;
  2554. numdat = ncof ; numcof = ncof ;
  2555. A = ININLIN numop numvar numdat numcof numder ;
  2556. 'SI' lcof ;
  2557. lvo = 'EGA' ('TYPE' valo) 'LISTREEL' ;
  2558. 'REPETER' iicof ncof ;
  2559. icof = &iicof ;
  2560. A . 'DAT' . icof . 'NOMDDL' = tcof . 'NOMINC' . icof ;
  2561. A . 'DAT' . icof . 'DISC' = tcof . 'DISC' ;
  2562. 'SI' lvo ;
  2563. A . 'DAT' . icof . 'VALEUR' = 'EXTRAIRE' valo icof ;
  2564. 'SINON' ;
  2565. A . 'DAT' . icof . 'VALEUR' = valo ;
  2566. 'FINSI' ;
  2567. A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  2568. A . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  2569. 'FIN' iicof ;
  2570. 'SINON' ;
  2571. ll = 'LECT' ;
  2572. 'FINSI' ;
  2573. lvt = 'EGA' ('TYPE' valt) 'LISTREEL' ;
  2574. iop = 0 ;
  2575. 'REPETER' iiinct ninct ;
  2576. iinct = &iiinct ;
  2577. A . 'VAR' . iinct . 'NOMDDL' = tnomt . 'NOMINC' . iinct ;
  2578. A . 'VAR' . iinct . 'DISC' = tnomt . 'DISC' ;
  2579. 'SI' lvalt ;
  2580. 'SI' lvt ;
  2581. A . 'VAR' . iinct . 'VALEUR' = 'EXTRAIRE' valt iinct ;
  2582. 'SINON' ;
  2583. A . 'VAR' . iinct . 'VALEUR' = valt ;
  2584. 'FINSI' ;
  2585. 'FINSI' ;
  2586. 'REPETER' iiincq nincq ;
  2587. 'REPETER' iiider numder ;
  2588. iop = '+' iop 1 ;
  2589. 'SI' lcof ;
  2590. icof = 'MINIMUM' ('LECT' &iiincq ncof) ;
  2591. A . iop . iinct . &iiider = 'LECT' icof ;
  2592. 'SINON' ;
  2593. A . iop . iinct . &iiider = ll ;
  2594. 'FINSI' ;
  2595. 'FIN' iiider ;
  2596. 'FIN' iiincq ;
  2597. 'FIN' iiinct ;
  2598. 'SI' iaxi ;
  2599. 'REPETER' iiincq nincq ;
  2600. iop = '+' iop 1 ;
  2601. 'SI' lcof ;
  2602. icof = 'MINIMUM' ('LECT' &iiincq ncof) ;
  2603. A . iop . 1 . 0 = 'LECT' icof ;
  2604. 'SINON' ;
  2605. A . iop . 1 . 0 = ll ;
  2606. 'FINSI' ;
  2607. 'FIN' iiincq ;
  2608. 'FINSI' ;
  2609. *
  2610. * 'SI' iaxi ;
  2611. * numdat = 1 ;
  2612. * numcof = dim '+' 1 ;
  2613. * 'SINON' ;
  2614. numdat = 0 ;
  2615. numcof = idim '*' idim '*' idim ;
  2616. * 'FINSI' ;
  2617. 'SI' iaxi ;
  2618. numdat = '+' numdat 2 ;
  2619. numcof = '+' numcof ('+' idim 2) ;
  2620. 'FINSI' ;
  2621. numvar = nincq ;
  2622. B = ININLIN numop numvar numdat numcof numder ;
  2623. *
  2624. lvq = 'EGA' ('TYPE' valq) 'LISTREEL' ;
  2625. 'REPETER' iiinc nincq ;
  2626. iinc = &iiinc ;
  2627. B . 'VAR' . iinc . 'NOMDDL' = tnomq . 'NOMINC' . iinc ;
  2628. B . 'VAR' . iinc . 'DISC' = tnomq . 'DISC' ;
  2629. 'SI' lvalq ;
  2630. 'SI' lvq ;
  2631. B . 'VAR' . iinc . 'VALEUR' = 'EXTRAIRE' valq iinc ;
  2632. 'SINON' ;
  2633. B . 'VAR' . iinc . 'VALEUR' = valq ;
  2634. 'FINSI' ;
  2635. 'FINSI' ;
  2636. 'FIN' iiinc ;
  2637. idat = 0 ;
  2638. icof = 0 ;
  2639. 'SI' iaxi ;
  2640. 'REPETER' iiidim idim ;
  2641. icof = '+' icof 1 ;
  2642. B . 'COF' . icof . 'COMPOR' = 'CHAINE' 'VNOR' &iiidim ;
  2643. B . 'COF' . icof . 'LDAT' = 'LECT' ;
  2644. 'FIN' iiidim ;
  2645. idat = '+' idat 1 ;
  2646. icof = '+' icof 1 ;
  2647. B . 'DAT' . idat . 'NOMDDL' = 'MOTS' 'SCAL' ;
  2648. B . 'DAT' . idat . 'DISC' = discg ;
  2649. B . 'DAT' . idat . 'VALEUR' = dprmt ;
  2650. B . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  2651. B . 'COF' . icof . 'LDAT' = 'LECT' idat ;
  2652. ll = 'LECT' icof ;
  2653. idat = '+' idat 1 ;
  2654. icof = '+' icof 1 ;
  2655. B . 'DAT' . idat . 'NOMDDL' = 'MOTS' 'SCAL' ;
  2656. B . 'DAT' . idat . 'DISC' = 'CSTE' ;
  2657. B . 'DAT' . idat . 'VALEUR' = deupi ;
  2658. B . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  2659. B . 'COF' . icof . 'LDAT' = 'LECT' idat ;
  2660. ll2 = 'LECT' icof ;
  2661. 'SINON' ;
  2662. ll = 'LECT' ;
  2663. 'FINSI' ;
  2664. *
  2665. iop = 0 ;
  2666. 'REPETER' iiinct ninct ;
  2667. 'REPETER' iiincq nincq ;
  2668. 'REPETER' iiider numder ;
  2669. iop = '+' iop 1 ;
  2670. icof = '+' icof 1 ;
  2671. lcomp = 'CHAINE' loi &iiincq &iiinct &iiider ;
  2672. * lcomp = 'CHAINE' loi &iiinct &iiincq &iiider ;
  2673. B . 'COF' . icof . 'COMPOR' = lcomp ;
  2674. B . 'COF' . icof . 'LDAT' = 'LECT' ;
  2675. B . iop . &iiincq . 0 = ('LECT' icof) 'ET' ll ;
  2676. 'FIN' iiider ;
  2677. 'FIN' iiincq ;
  2678. 'FIN' iiinct ;
  2679. 'SI' iaxi ;
  2680. 'REPETER' iiincq nincq ;
  2681. iincq = &iiincq ;
  2682. iop = '+' iop 1 ;
  2683. B . iop . iincq . 0 = ('LECT' iincq) 'ET' ll2 ;
  2684. 'FIN' iiincq ;
  2685. 'FINSI' ;
  2686. *
  2687. * mgnorkt = NLIN discg _mt A B 'CRES' methgau ;
  2688. mgnorkt = NLIN discg _mt A B methgau ;
  2689. *
  2690. 'RESPRO' mgnorkt ;
  2691. 'FINPROC' ;
  2692. *
  2693. * End of procedure file GNORKTAN
  2694. *
  2695. *ENDPROCEDUR gnorktan
  2696. *BEGINPROCEDUR gnor
  2697. ************************************************************************
  2698. * NOM : GNOR
  2699. * DESCRIPTION : Calcule le champ de normales à une surface.
  2700. * Peut servir à calculer une pression, un potentiel
  2701. * lié à la gravité, un volume contenu dans une surface.
  2702. * Attention à l'orientation de la surface !
  2703. *
  2704. * Computes a field of normal to a surface.
  2705. * Also useful to compute a pressure field,
  2706. * a gravity potential field, a volume enclosed
  2707. * by a surface.
  2708. * WARNING : The orientation of the surface matters !
  2709. *
  2710. *
  2711. *
  2712. *
  2713. * LANGAGE : GIBIANE-CAST3M
  2714. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  2715. * mél : gounand@semt2.smts.cea.fr
  2716. **********************************************************************
  2717. * VERSION : v1, 22/04/2011
  2718. * HISTORIQUE : v1, 22/04/2011, création
  2719. * HISTORIQUE :
  2720. * HISTORIQUE :
  2721. ************************************************************************
  2722. *
  2723. *
  2724. 'DEBPROC' GNOR ;
  2725. 'ARGUMENT' _mt*'MAILLAGE' ;
  2726. 'ARGUMENT' tdisc*'TABLE' ;
  2727. *
  2728. * Lectures
  2729. *
  2730. dim = 'VALEUR' 'DIME' ;
  2731. debug = FAUX ;
  2732. lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
  2733. 'NCOF' 'FCOF' 'CCOF' ;
  2734. * Il faut initialiser valt et valq, sinon on peut capturer ceux de
  2735. * la procédure appelante
  2736. valt = 'valt' ; valq = 'valq' ;
  2737. 'REPETER' imotcle ;
  2738. 'ARGUMENT' motcle/'MOT' ;
  2739. 'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
  2740. 'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
  2741. cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
  2742. 'FINSI' ;
  2743. 'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
  2744. 'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
  2745. 'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
  2746. tst1 = 'EGA' motcle 'FPRI' ; tst2 = 'EGA' motcle 'FDUA' ;
  2747. tst3 = 'EGA' motcle 'FCOF' ;
  2748. tst = tst1 'OU' tst2 'OU' tst3 ;
  2749. 'SI' tst ;
  2750. 'SI' tst1 ; tt = TDISC . nomt ; 'FINSI' ;
  2751. 'SI' tst2 ; tt = TDISC . nomq ; 'FINSI' ;
  2752. 'SI' tst3 ; tt = TDISC . nomo ; 'FINSI' ;
  2753. isvec = ('>' ('DIME' (tt. 'NOMINC')) 1) ;
  2754. 'SI' isvec ; 'ARGUMENT' valv*'LISTREEL' ; 'SINON' ;
  2755. 'ARGUMENT' valv*'FLOTTANT' ;
  2756. 'FINSI' ;
  2757. 'SI' tst1 ; valt = valv ; 'FINSI' ;
  2758. 'SI' tst2 ; valq = valv ; 'FINSI' ;
  2759. 'SI' tst3 ; valo = valv ; 'FINSI' ;
  2760. 'FINSI' ;
  2761. 'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
  2762. 'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
  2763. 'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
  2764. 'FIN' imotcle ;
  2765. *
  2766. * Tests
  2767. *
  2768. discg = TDISC . 'GEOM' . 'DISC' ;
  2769. 'SI' ('EXISTE' tdisc 'methgau') ;
  2770. methgau = tdisc . 'methgau' . 'mass' ;
  2771. 'SINON' ;
  2772. methgau = 'GAU7' ;
  2773. 'FINSI' ;
  2774. tnomt = TDISC . nomt ;
  2775. lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
  2776. tnomq = TDISC . nomq ;
  2777. lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
  2778. * Scalaire ou vecteur
  2779. ninct = 'DIME' (tnomt . 'NOMINC') ;
  2780. nincq = 'DIME' (tnomq . 'NOMINC') ;
  2781. 'SI' ('ET' ('NEG' ninct 1) ('NEG' ninct dim)) ;
  2782. cherr = 'CHAINE'
  2783. 'la primale doit etre un scalaire ou un vecteur' ;
  2784. 'ERREUR' cherr ;
  2785. 'FINSI' ;
  2786. 'SI' ('NEG' nincq dim) ;
  2787. cherr = 'CHAINE'
  2788. 'la duale doit etre un vecteur' ;
  2789. 'ERREUR' cherr ;
  2790. 'FINSI' ;
  2791. *ninc = ninct ;
  2792. *
  2793. lcof = 'EXISTE' TDISC nomo ;
  2794. 'SI' lcof ; tcof = TDISC . nomo ;
  2795. ncof = 'DIME' (tcof . 'NOMINC') ;
  2796. 'SINON' ; ncof = 0 ;
  2797. 'FINSI' ;
  2798. *
  2799. 'SI' debug ;
  2800. 'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
  2801. 'SINON' ; 'MESSAGE' 'pas de coef detecte' ;
  2802. 'FINSI' ;
  2803. 'FINSI' ;
  2804. *
  2805. vdim = 'VALEUR' 'DIME' ;
  2806. vmod = 'VALEUR' 'MODE' ;
  2807. idim = 0 ;
  2808. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  2809. idim = 2 ;
  2810. iaxi = FAUX ;
  2811. 'FINSI' ;
  2812. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  2813. idim = 2 ;
  2814. iaxi = VRAI ;
  2815. 'FINSI' ;
  2816. 'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  2817. idim = 3 ;
  2818. iaxi = FAUX ;
  2819. 'FINSI' ;
  2820. 'SI' ('EGA' vdim 1) ;
  2821. idim = 1 ;
  2822. iaxi = FAUX ;
  2823. 'FINSI' ;
  2824. * 'MESSAGE' ('CHAINE' 'iaxi=' iaxi );
  2825. 'SI' ('EGA' idim 0) ;
  2826. 'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  2827. 'FINSI' ;
  2828. 'SI' iaxi ;
  2829. dprmt = '*' ('COORDONNEE' 1 _mt) ('*' PI 2.D0) ;
  2830. 'FINSI' ;
  2831. *
  2832. * Optimisation possible : construire la matrice par blocs
  2833. * qd valt et valq ne sont pas donnés
  2834. *
  2835. numop = nincq ; numder = idim ; numvar = ninct ;
  2836. numdat = ncof ; numcof = ncof ;
  2837. A = ININLIN numop numvar numdat numcof numder ;
  2838. 'SI' lcof ;
  2839. lvo = 'EGA' ('TYPE' valo) 'LISTREEL' ;
  2840. 'REPETER' iicof ncof ;
  2841. icof = &iicof ;
  2842. A . 'DAT' . icof . 'NOMDDL' = tcof . 'NOMINC' . icof ;
  2843. A . 'DAT' . icof . 'DISC' = tcof . 'DISC' ;
  2844. 'SI' lvo ;
  2845. A . 'DAT' . icof . 'VALEUR' = 'EXTRAIRE' valo icof ;
  2846. 'SINON' ;
  2847. A . 'DAT' . icof . 'VALEUR' = valo ;
  2848. 'FINSI' ;
  2849. A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  2850. A . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  2851. 'FIN' iicof ;
  2852. 'SINON' ;
  2853. ll = 'LECT' ;
  2854. 'FINSI' ;
  2855. lvt = 'EGA' ('TYPE' valt) 'LISTREEL' ;
  2856. 'REPETER' iiincq nincq ;
  2857. iincq = &iiincq ;
  2858. iinct = 'MINIMUM' ('LECT' iincq ninct) ;
  2859. A . 'VAR' . iinct . 'NOMDDL' = tnomt . 'NOMINC' . iinct ;
  2860. A . 'VAR' . iinct . 'DISC' = tnomt . 'DISC' ;
  2861. 'SI' lvalt ;
  2862. 'SI' lvt ;
  2863. A . 'VAR' . iinct . 'VALEUR' = 'EXTRAIRE' valt iinct ;
  2864. 'SINON' ;
  2865. A . 'VAR' . iinct . 'VALEUR' = valt ;
  2866. 'FINSI' ;
  2867. 'FINSI' ;
  2868. 'SI' lcof ;
  2869. icof = 'MINIMUM' ('LECT' iincq ncof) ;
  2870. A . iincq . iinct . 0 = 'LECT' icof ;
  2871. 'SINON' ;
  2872. A . iincq . iinct . 0 = ll ;
  2873. 'FINSI' ;
  2874. 'FIN' iiincq ;
  2875. *
  2876. 'SI' iaxi ;
  2877. numdat = 1 ;
  2878. numcof = dim '+' 1 ;
  2879. 'SINON' ;
  2880. numdat = 0 ;
  2881. numcof = dim ;
  2882. 'FINSI' ;
  2883. numvar = nincq ;
  2884. B = ININLIN numop numvar numdat numcof numder ;
  2885. icof = 0 ;
  2886. 'REPETER' iiidim idim ;
  2887. icof = '+' icof 1 ;
  2888. B . 'COF' . icof . 'COMPOR' = 'CHAINE' 'VNOR' &iiidim ;
  2889. B . 'COF' . icof . 'LDAT' = 'LECT' ;
  2890. 'FIN' iiidim ;
  2891. *
  2892. 'SI' iaxi ;
  2893. icof = '+' icof 1 ;
  2894. B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  2895. B . 'DAT' . 1 . 'DISC' = discg ;
  2896. B . 'DAT' . 1 . 'VALEUR' = dprmt ;
  2897. B . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  2898. B . 'COF' . icof . 'LDAT' = 'LECT' 1 ;
  2899. ll = 'LECT' icof ;
  2900. 'SINON' ;
  2901. ll = 'LECT' ;
  2902. 'FINSI' ;
  2903. lvq = 'EGA' ('TYPE' valq) 'LISTREEL' ;
  2904. 'REPETER' iiincq nincq ;
  2905. iincq = &iiincq ;
  2906. B . 'VAR' . iincq . 'NOMDDL' = tnomq . 'NOMINC' . iincq ;
  2907. B . 'VAR' . iincq . 'DISC' = tnomq . 'DISC' ;
  2908. 'SI' lvalq ;
  2909. 'SI' lvq ;
  2910. B . 'VAR' . iincq . 'VALEUR' = 'EXTRAIRE' valq iincq ;
  2911. 'SINON' ;
  2912. B . 'VAR' . iincq . 'VALEUR' = valq ;
  2913. 'FINSI' ;
  2914. 'FINSI' ;
  2915. B . iincq . iincq . 0 = ('LECT' iincq) 'ET' ll ;
  2916. 'FIN' iiincq ;
  2917. *
  2918. mgnor = NLIN discg _mt A B methgau ;
  2919. *
  2920. 'RESPRO' mgnor ;
  2921. 'FINPROC' ;
  2922. *
  2923. * End of procedure file GNOR
  2924. *
  2925. *ENDPROCEDUR gnor
  2926. *BEGINPROCEDUR grig
  2927. ************************************************************************
  2928. * NOM : GRIG
  2929. * DESCRIPTION :
  2930. *
  2931. *
  2932. *
  2933. * LANGAGE : GIBIANE-CAST3M
  2934. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  2935. * mél : gounand@semt2.smts.cea.fr
  2936. **********************************************************************
  2937. * VERSION : v1, ??/??/2007, version initiale
  2938. * HISTORIQUE : v1, ??/??/2007, création
  2939. * HISTORIQUE :
  2940. * HISTORIQUE :
  2941. ************************************************************************
  2942. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  2943. * en cas de modification de ce sous-programme afin de faciliter
  2944. * la maintenance !
  2945. ************************************************************************
  2946. *
  2947. *
  2948. 'DEBPROC' GRIG ;
  2949. 'ARGUMENT' _mt*'MAILLAGE' ;
  2950. 'ARGUMENT' tdisc*'TABLE' ;
  2951. *
  2952. * Lectures
  2953. *
  2954. debug = FAUX ;
  2955. lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
  2956. 'NCOF' 'FCOF' 'CCOF' 'LAPN' 'GMBT' ;
  2957. * Il faut initialiser valt et valq, sinon on peut capturer ceux de
  2958. * la procédure appelante
  2959. valt = 'valt' ; valq = 'valq' ;
  2960. llapn = 0 ;
  2961. 'REPETER' imotcle ;
  2962. 'ARGUMENT' motcle/'MOT' ;
  2963. 'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
  2964. 'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
  2965. cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
  2966. 'FINSI' ;
  2967. 'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
  2968. 'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
  2969. 'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
  2970. tst1 = 'EGA' motcle 'FPRI' ; tst2 = 'EGA' motcle 'FDUA' ;
  2971. tst = tst1 'OU' tst2 ;
  2972. 'SI' tst ;
  2973. 'SI' tst1 ; tt = TDISC . nomt ; 'FINSI' ;
  2974. 'SI' tst2 ; tt = TDISC . nomq ; 'FINSI' ;
  2975. isvec = ('>' ('DIME' (tt. 'NOMINC')) 1) ;
  2976. 'SI' isvec ; 'ARGUMENT' valv*'LISTREEL' ; 'SINON' ;
  2977. 'ARGUMENT' valv*'FLOTTANT' ;
  2978. 'FINSI' ;
  2979. 'SI' tst1 ; valt = valv ; 'FINSI' ;
  2980. 'SI' tst2 ; valq = valv ; 'FINSI' ;
  2981. 'FINSI' ;
  2982. 'SI' ('EGA' motcle 'FCOF') ; 'ARGUMENT' valo*'FLOTTANT' ; 'FINSI' ;
  2983. 'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
  2984. 'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
  2985. 'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
  2986. 'SI' ('EGA' motcle 'LAPN') ; llapn = 1 ; 'FINSI' ;
  2987. 'SI' ('EGA' motcle 'GMBT') ; llapn = 2 ; 'FINSI' ;
  2988. 'FIN' imotcle ;
  2989. *
  2990. * Tests
  2991. *
  2992. discg = TDISC . 'GEOM' . 'DISC' ;
  2993. 'SI' ('EXISTE' tdisc 'methgau') ;
  2994. methgau = tdisc . 'methgau' . 'rigi' ;
  2995. 'SINON' ;
  2996. methgau = 'GAU7' ;
  2997. 'FINSI' ;
  2998. tnomt = TDISC . nomt ;
  2999. lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
  3000. tnomq = TDISC . nomq ;
  3001. lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
  3002. * Scalaire ou vecteur
  3003. ninct = 'DIME' (tnomt . 'NOMINC') ;
  3004. nincq = 'DIME' (tnomq . 'NOMINC') ;
  3005. 'SI' ('NEG' ninct nincq) ;
  3006. cherr = 'CHAINE'
  3007. 'les primales et duales nont pas le meme nombre de composantes' ;
  3008. 'ERREUR' cherr ;
  3009. 'FINSI' ;
  3010. 'SI' ('NEG' ninct ('VALEUR' 'DIME')) ;
  3011. cherr = 'CHAINE'
  3012. 'les inconnues doivent etre vectorielles' ;
  3013. 'ERREUR' cherr ;
  3014. 'FINSI' ;
  3015. *
  3016. ninc = ninct ;
  3017. *
  3018. lcof = 'EXISTE' TDISC nomo ;
  3019. 'SI' lcof ; ncof = 1 ; tcof = TDISC . nomo ;
  3020. 'SINON' ; ncof = 0 ;
  3021. 'FINSI' ;
  3022. *
  3023. 'SI' debug ;
  3024. 'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
  3025. 'SINON' ; 'MESSAGE' 'pas de coef detecte' ;
  3026. 'FINSI' ;
  3027. 'FINSI' ;
  3028. *
  3029. vdim = 'VALEUR' 'DIME' ;
  3030. vmod = 'VALEUR' 'MODE' ;
  3031. idim = 0 ;
  3032. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  3033. idim = 2 ;
  3034. iaxi = FAUX ;
  3035. 'FINSI' ;
  3036. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  3037. idim = 2 ;
  3038. iaxi = VRAI ;
  3039. 'FINSI' ;
  3040. 'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  3041. idim = 3 ;
  3042. iaxi = FAUX ;
  3043. 'FINSI' ;
  3044. 'SI' ('EGA' vdim 1) ;
  3045. idim = 1 ;
  3046. iaxi = FAUX ;
  3047. 'FINSI' ;
  3048. * 'MESSAGE' ('CHAINE' 'iaxi=' iaxi );
  3049. 'SI' ('EGA' idim 0) ;
  3050. 'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  3051. 'FINSI' ;
  3052. 'SI' iaxi ;
  3053. rmt = 'COORDONNEE' 1 _mt ;
  3054. deupi = '*' PI 2.D0 ;
  3055. 'FINSI' ;
  3056. *
  3057. * Optimisation possible : construire la matrice par blocs
  3058. * qd valt et valq ne sont pas donnés
  3059. *
  3060. *
  3061. *Bug ? numop = ('**' ninc 2) '+' 1 ;
  3062. numop = '**' ninc 2 ;
  3063. 'SI' iaxi ; numop = '+' numop 1 ; 'FINSI' ;
  3064. numder = idim ;
  3065. numvar = ninc ;
  3066. ncof = '+' ncof 1 ;
  3067. *delete 'SI' iaxi ; ncof = '+' ncof 1 ; 'FINSI' ;
  3068. numdat = ncof ;
  3069. numcof = ncof ;
  3070. *
  3071. A = ININLIN numop numvar numdat numcof numder ;
  3072. *
  3073. lvt = 'EGA' ('TYPE' valt) 'LISTREEL' ;
  3074. 'REPETER' iiinc ninc ;
  3075. iinc = &iiinc ;
  3076. A . 'VAR' . iinc . 'NOMDDL' = tnomt . 'NOMINC' . iinc ;
  3077. A . 'VAR' . iinc . 'DISC' = tnomt . 'DISC' ;
  3078. 'SI' lvalt ;
  3079. 'SI' lvt ;
  3080. A . 'VAR' . iinc . 'VALEUR' = 'EXTRAIRE' valt iinc ;
  3081. 'SINON' ;
  3082. A . 'VAR' . iinc . 'VALEUR' = valt ;
  3083. 'FINSI' ;
  3084. 'FINSI' ;
  3085. 'FIN' iiinc ;
  3086. *
  3087. icof = 0 ;
  3088. ll = 'LECT' ;
  3089. icof = '+' icof 1 ;
  3090. A . 'DAT' . icof . 'NOMDDL' = 'MOTS' 'SCAL' ;
  3091. A . 'DAT' . icof . 'DISC' = 'CSTE' ;
  3092. A . 'DAT' . icof . 'VALEUR' = 2.D0 ;
  3093. A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  3094. A . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  3095. ll = 'LECT' ;
  3096. ll2 = 'LECT' icof ;
  3097. 'SI' lcof ;
  3098. icof = '+' icof 1 ;
  3099. A . 'DAT' . icof . 'NOMDDL' = tcof . 'NOMINC' . 1 ;
  3100. A . 'DAT' . icof . 'DISC' = tcof . 'DISC' ;
  3101. A . 'DAT' . icof . 'VALEUR' = valo ;
  3102. A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  3103. A . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  3104. ll = 'ET' ll ('LECT' icof) ;
  3105. ll2 = 'ET' ll2 ('LECT' icof) ;
  3106. 'FINSI' ;
  3107. *
  3108. iop = 0 ;
  3109. 'REPETER' iidim idim ;
  3110. 'REPETER' jidim idim ;
  3111. iop = '+' iop 1 ;
  3112. 'SI' ('EGA' &iidim &jidim) ;
  3113. 'SI' ('EGA' llapn 0) ;
  3114. A . iop . &iidim . &jidim = ll2 ;
  3115. 'SINON' ;
  3116. A . iop . &iidim . &jidim = ll ;
  3117. 'FINSI' ;
  3118. 'SINON' ;
  3119. 'SI' ('NEG' llapn 2) ;
  3120. A . iop . &iidim . &jidim = ll ;
  3121. 'FINSI' ;
  3122. 'SI' ('NEG' llapn 1) ;
  3123. A . iop . &jidim . &iidim = ll ;
  3124. 'FINSI' ;
  3125. 'FINSI' ;
  3126. 'FIN' jidim ;
  3127. 'FIN' iidim ;
  3128. 'SI' iaxi ;
  3129. iop = '+' iop 1 ;
  3130. 'SI' ('EGA' llapn 0) ;
  3131. A . iop . 1 . 0 = ll2 ;
  3132. 'SINON' ;
  3133. A . iop . 1 . 0 = ll ;
  3134. 'FINSI' ;
  3135. 'FINSI' ;
  3136. *
  3137. 'SI' iaxi ;
  3138. numdat = 2 ;
  3139. numcof = 2 ;
  3140. 'SINON' ;
  3141. numdat = 0 ;
  3142. numcof = 0 ;
  3143. 'FINSI' ;
  3144. *
  3145. B = ININLIN numop numvar numdat numcof numder ;
  3146. *
  3147. icof = 0 ;
  3148. *
  3149. 'SI' iaxi ;
  3150. icof = '+' icof 1 ;
  3151. B . 'DAT' . icof . 'NOMDDL' = 'MOTS' 'SCAL' ;
  3152. B . 'DAT' . icof . 'DISC' = discg ;
  3153. B . 'DAT' . icof . 'VALEUR' = rmt ;
  3154. B . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  3155. B . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  3156. icof = '+' icof 1 ;
  3157. B . 'DAT' . icof . 'NOMDDL' = 'MOTS' 'SCAL' ;
  3158. B . 'DAT' . icof . 'DISC' = 'CSTE' ;
  3159. B . 'DAT' . icof . 'VALEUR' = deupi ;
  3160. B . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  3161. B . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  3162. ll = 'LECT' ('-' icof 1) icof ;
  3163. mic = '*' ('-' icof 1) -1 ;
  3164. llb = 'LECT' mic icof ;
  3165. 'FINSI' ;
  3166. *
  3167. lvq = 'EGA' ('TYPE' valq) 'LISTREEL' ;
  3168. 'REPETER' iiinc ninc ;
  3169. iinc = &iiinc ;
  3170. B . 'VAR' . iinc . 'NOMDDL' = tnomq . 'NOMINC' . iinc ;
  3171. B . 'VAR' . iinc . 'DISC' = tnomq . 'DISC' ;
  3172. 'SI' lvalq ;
  3173. 'SI' lvq ;
  3174. B . 'VAR' . iinc . 'VALEUR' = 'EXTRAIRE' valq iinc ;
  3175. 'SINON' ;
  3176. B . 'VAR' . iinc . 'VALEUR' = valq ;
  3177. 'FINSI' ;
  3178. 'FINSI' ;
  3179. 'FIN' iiinc ;
  3180. *
  3181. iop = 0 ;
  3182. 'REPETER' iidim idim ;
  3183. 'REPETER' jidim idim ;
  3184. iop = '+' iop 1 ;
  3185. B . iop . &iidim . &jidim = ll ;
  3186. 'FIN' jidim ;
  3187. 'FIN' iidim ;
  3188. 'SI' iaxi ;
  3189. iop = '+' iop 1 ;
  3190. B . iop . 1 . 0 = llb ;
  3191. * B . iop . 1 . 0 = ll ;
  3192. 'FINSI' ;
  3193. *
  3194. mgrig = NLINP discg _mt A B methgau ;
  3195. * Integration par parties
  3196. * mgrig = '*' mgrig -1.D0 ;
  3197. *
  3198. 'RESPRO' mgrig ;
  3199. 'FINPROC' ;
  3200. *
  3201. * End of procedure file GRIG
  3202. *
  3203. *ENDPROCEDUR grig
  3204. *BEGINPROCEDUR gugrad2
  3205. ************************************************************************
  3206. * NOM : GUGRAD2
  3207. * DESCRIPTION : Une matrice de convection
  3208. *
  3209. *
  3210. *
  3211. * LANGAGE : GIBIANE-CAST3M
  3212. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  3213. * mél : gounand@semt2.smts.cea.fr
  3214. **********************************************************************
  3215. * VERSION : v2, 14/03/2006, mise à jour NLIN évolué
  3216. * VERSION : v1, 13/05/2004, version initiale
  3217. * HISTORIQUE : v1, 13/05/2004, création
  3218. * HISTORIQUE :
  3219. * HISTORIQUE :
  3220. ************************************************************************
  3221. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  3222. * en cas de modification de ce sous-programme afin de faciliter
  3223. * la maintenance !
  3224. ************************************************************************
  3225. *
  3226. *
  3227. 'DEBPROC' GUGRAD2 ;
  3228. 'ARGUMENT' _mt*'MAILLAGE' ;
  3229. 'ARGUMENT' _smt/'MAILLAGE' ;
  3230. 'ARGUMENT' tdisc*'TABLE' ;
  3231. *
  3232. * Lectures
  3233. *
  3234. debug = FAUX ;
  3235. lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
  3236. 'NVIT' 'FVIT' 'CVIT' 'NCOF' 'FCOF' 'CCOF' ;
  3237. 'REPETER' imotcle ;
  3238. 'ARGUMENT' motcle/'MOT' ;
  3239. 'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
  3240. 'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
  3241. cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
  3242. 'FINSI' ;
  3243. 'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
  3244. 'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
  3245. 'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
  3246. 'SI' ('EGA' motcle 'NVIT') ; 'ARGUMENT' nomu*'MOT' ; 'FINSI' ;
  3247. tst1 = 'EGA' motcle 'FPRI' ; tst2 = 'EGA' motcle 'FDUA' ;
  3248. tst = tst1 'OU' tst2 ;
  3249. 'SI' tst ;
  3250. 'SI' tst1 ; tt = TDISC . nomt ; 'FINSI' ;
  3251. 'SI' tst2 ; tt = TDISC . nomq ; 'FINSI' ;
  3252. isvec = ('>' ('DIME' (tt. 'NOMINC')) 1) ;
  3253. 'SI' isvec ; 'ARGUMENT' valv*'LISTREEL' ; 'SINON' ;
  3254. 'ARGUMENT' valv*'FLOTTANT' ;
  3255. 'FINSI' ;
  3256. 'SI' tst1 ; valt = valv ; 'FINSI' ;
  3257. 'SI' tst2 ; valq = valv ; 'FINSI' ;
  3258. 'FINSI' ;
  3259. 'SI' ('EGA' motcle 'FCOF') ; 'ARGUMENT' valo*'FLOTTANT' ; 'FINSI' ;
  3260. 'SI' ('EGA' motcle 'FVIT') ; 'ARGUMENT' valu*'LISTREEL' ; 'FINSI' ;
  3261. 'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
  3262. 'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
  3263. 'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
  3264. 'SI' ('EGA' motcle 'CVIT') ; 'ARGUMENT' valu*'CHPOINT' ; 'FINSI' ;
  3265. 'FIN' imotcle ;
  3266. *
  3267. * Tests
  3268. *
  3269. discg = TDISC . 'GEOM' . 'DISC' ;
  3270. 'SI' ('EXISTE' tdisc 'methgau') ;
  3271. methgau = tdisc . 'methgau' . 'amor' ;
  3272. 'SINON' ;
  3273. methgau = 'GAU7' ;
  3274. 'FINSI' ;
  3275. tnomt = TDISC . nomt ;
  3276. lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
  3277. tnomq = TDISC . nomq ;
  3278. lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
  3279. tnomu = TDISC . nomu ;
  3280. * Scalaire ou vecteur
  3281. ninct = 'DIME' (tnomt . 'NOMINC') ;
  3282. nincq = 'DIME' (tnomq . 'NOMINC') ;
  3283. 'SI' ('NEG' ninct nincq) ;
  3284. cherr = 'CHAINE'
  3285. 'les primales et duales nont pas le meme nombre de composantes' ;
  3286. 'ERREUR' cherr ;
  3287. 'FINSI' ;
  3288. ninc = ninct ;
  3289. *
  3290. lcof = 'EXISTE' TDISC nomo ;
  3291. 'SI' lcof ; ncof = 1 ; tcof = TDISC . nomo ;
  3292. 'SINON' ; ncof = 0 ;
  3293. 'FINSI' ;
  3294. *
  3295. 'SI' debug ;
  3296. 'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
  3297. 'SINON' ; 'MESSAGE' 'pas de coef detecte' ;
  3298. 'FINSI' ;
  3299. 'FINSI' ;
  3300. *
  3301. vdim = 'VALEUR' 'DIME' ;
  3302. vmod = 'VALEUR' 'MODE' ;
  3303. idim = 0 ;
  3304. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  3305. idim = 2 ;
  3306. iaxi = FAUX ;
  3307. 'FINSI' ;
  3308. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  3309. idim = 2 ;
  3310. iaxi = VRAI ;
  3311. 'FINSI' ;
  3312. 'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  3313. idim = 3 ;
  3314. iaxi = FAUX ;
  3315. 'FINSI' ;
  3316. 'SI' ('EGA' vdim 1) ;
  3317. idim = 1 ;
  3318. iaxi = FAUX ;
  3319. 'FINSI' ;
  3320. 'SI' ('EGA' idim 0) ;
  3321. 'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  3322. 'FINSI' ;
  3323. 'SI' iaxi ;
  3324. dprmt = '*' ('COORDONNEE' 1 _mt) ('*' PI 2.D0) ;
  3325. 'FINSI' ;
  3326. * Scalaire ou vecteur
  3327. nincu = 'DIME' (tnomu . 'NOMINC') ;
  3328. 'SI' ('NEG' nincu idim) ;
  3329. cherr = 'CHAINE'
  3330. 'la vitesse doit etre un vecteur' ;
  3331. 'ERREUR' cherr ;
  3332. 'FINSI' ;
  3333. ncof = '+' ncof nincu ;
  3334. *
  3335. * Optimisation possible : construire la matrice par blocs
  3336. * qd valt et valq ne sont pas donnés
  3337. *
  3338. numop = ninc ; numder = idim ; numvar = ninc ;
  3339. numdat = ncof ; numcof = ncof ;
  3340. A = ININLIN numop numvar numdat numcof numder ;
  3341. *
  3342. lvt = 'EGA' ('TYPE' valt) 'LISTREEL' ;
  3343. 'REPETER' iiinc ninc ;
  3344. iinc = &iiinc ;
  3345. A . 'VAR' . iinc . 'NOMDDL' = tnomt . 'NOMINC' . iinc ;
  3346. A . 'VAR' . iinc . 'DISC' = tnomt . 'DISC' ;
  3347. 'SI' lvalt ;
  3348. 'SI' lvt ;
  3349. A . 'VAR' . iinc . 'VALEUR' = 'EXTRAIRE' valt iinc ;
  3350. 'SINON' ;
  3351. A . 'VAR' . iinc . 'VALEUR' = valt ;
  3352. 'FINSI' ;
  3353. 'FINSI' ;
  3354. 'FIN' iiinc ;
  3355. *
  3356. lvu = 'EGA' ('TYPE' valu) 'LISTREEL' ;
  3357. icof = 0 ;
  3358. 'REPETER' iiincu nincu ;
  3359. iincu = &iiincu ;
  3360. icof = icof '+' 1 ;
  3361. A . 'DAT' . icof . 'NOMDDL' = tnomu . 'NOMINC' . iincu ;
  3362. A . 'DAT' . icof . 'DISC' = tnomu . 'DISC' ;
  3363. 'SI' lvu ;
  3364. A . 'DAT' . icof . 'VALEUR' = 'EXTRAIRE' valu iincu ;
  3365. 'SINON' ;
  3366. A . 'DAT' . icof . 'VALEUR' = valu ;
  3367. 'FINSI' ;
  3368. A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  3369. A . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  3370. 'FIN' iiincu ;
  3371. 'SI' lcof ;
  3372. icof = icof '+' 1 ;
  3373. A . 'DAT' . icof . 'NOMDDL' = tcof . 'NOMINC' . 1 ;
  3374. A . 'DAT' . icof . 'DISC' = tcof . 'DISC' ;
  3375. A . 'DAT' . icof . 'VALEUR' = valo ;
  3376. A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  3377. A . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  3378. ll = 'LECT' icof ;
  3379. 'SINON' ;
  3380. ll = 'LECT' ;
  3381. 'FINSI' ;
  3382. *
  3383. 'REPETER' iiinc ninc ;
  3384. iinc = &iiinc ;
  3385. 'REPETER' iiidim idim ;
  3386. iidim = &iiidim ;
  3387. A . iinc . iinc . iidim = ('ET' ('LECT' iidim) ll) ;
  3388. 'FIN' iiidim ;
  3389. 'FIN' iiinc ;
  3390. *
  3391. 'SI' iaxi ;
  3392. numdat = 1 ;
  3393. numcof = 1 ;
  3394. 'SINON' ;
  3395. numdat = 0 ;
  3396. numcof = 0 ;
  3397. 'FINSI' ;
  3398. B = ININLIN numop numvar numdat numcof numder ;
  3399. 'SI' iaxi ;
  3400. B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  3401. B . 'DAT' . 1 . 'DISC' = discg ;
  3402. B . 'DAT' . 1 . 'VALEUR' = dprmt ;
  3403. B . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  3404. B . 'COF' . 1 . 'LDAT' = 'LECT' 1 ;
  3405. ll = 'LECT' 1 ;
  3406. 'SINON' ;
  3407. ll = 'LECT' ;
  3408. 'FINSI' ;
  3409. lvq = 'EGA' ('TYPE' valq) 'LISTREEL' ;
  3410. 'REPETER' iiinc ninc ;
  3411. iinc = &iiinc ;
  3412. B . 'VAR' . iinc . 'NOMDDL' = tnomq . 'NOMINC' . iinc ;
  3413. B . 'VAR' . iinc . 'DISC' = tnomq . 'DISC' ;
  3414. 'SI' lvalq ;
  3415. 'SI' lvq ;
  3416. B . 'VAR' . iinc . 'VALEUR' = 'EXTRAIRE' valq iinc ;
  3417. 'SINON' ;
  3418. B . 'VAR' . iinc . 'VALEUR' = valq ;
  3419. 'FINSI' ;
  3420. 'FINSI' ;
  3421. B . iinc . iinc . 0 = ll ;
  3422. 'FIN' iiinc ;
  3423. *
  3424. 'SI' ('EXISTE' _smt) ;
  3425. mgugrad2 = 'NLIN' discg _mt _smt A B methgau ;
  3426. 'SINON' ;
  3427. mgugrad2 = NLINP discg _mt A B methgau ;
  3428. 'FINSI' ;
  3429. *
  3430. 'RESPRO' mgugrad2 ;
  3431. 'FINPROC' ;
  3432. *
  3433. * End of procedure file GUGRAD2
  3434. *
  3435. *ENDPROCEDUR gugrad2
  3436. *BEGINPROCEDUR gvol
  3437. ************************************************************************
  3438. * NOM : GVOL
  3439. * DESCRIPTION :
  3440. * Calcule le volume compris dans une surface fermée
  3441. * La normale doit être vers l'intérieur pour que le volume soit positif
  3442. *
  3443. *
  3444. * LANGAGE : GIBIANE-CAST3M
  3445. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  3446. * mél : gounand@semt2.smts.cea.fr
  3447. **********************************************************************
  3448. * VERSION : v1, 22/04/2011, version initiale
  3449. * HISTORIQUE : v1, 22/04/2011, création
  3450. * HISTORIQUE :
  3451. * HISTORIQUE :
  3452. ************************************************************************
  3453. *
  3454. *
  3455. 'DEBPROC' GVOL ;
  3456. 'ARGUMENT' _surf*'MAILLAGE' ;
  3457. 'ARGUMENT' tdisc*'TABLE' ;
  3458. 'ARGUMENT' dbg/'LOGIQUE' ;
  3459. *
  3460. 'SI' ('NON' ('EXISTE' dbg)) ;
  3461. dbg = FAUX ;
  3462. 'FINSI' ;
  3463. *
  3464. * Vecteur position et calcul du volume
  3465. NOMVIT = @STBL (TDISC . 'XN' . 'NOMINC') ;
  3466. DISCG = TDISC . 'GEOM' . 'DISC' ;
  3467. vdim = 'VALEUR' 'DIME' ;
  3468. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  3469. fdim = 3 ;
  3470. 'SINON' ;
  3471. fdim = vdim ;
  3472. 'FINSI' ;
  3473. vposc = GETCOO _surf nomvit ;
  3474. * 'SI' iaxi ;
  3475. * rs zs = 'COORDONNEE' _surf ;
  3476. * nr = 'EXTRAIRE' nomvit 1 ;
  3477. * nz = 'EXTRAIRE' nomvit 2 ;
  3478. * vposc =
  3479. * 'FINSI' ;
  3480. * fvol = GNOR _surf tdisc 'NPRI' ('CHAINE' discg 'V') 'CPRI' vpos
  3481. * 'NDUA' 'CSTEV' ;
  3482. * rfvol = 'RESULT' fvol ;
  3483. * volx = 'MAXIMUM' ('EXCO' 'UX' rfvol) ;
  3484. * voly = 'MAXIMUM' ('EXCO' 'UY' rfvol) ;
  3485. * vol = '/' ('+' volx voly) vdim ;
  3486. fvolc = GNOR _surf tdisc 'NPRI' discg
  3487. 'NCOF' (chai discg 'V')
  3488. 'CCOF' vposc
  3489. 'NDUA' (chai discg 'V')
  3490. 'FDUA' ('PROG' vdim * 1.) ;
  3491. volc = '/' ('MAXIMUM' ('RESULT' fvolc))
  3492. fdim ;
  3493. vol = volc '*' -1. ;
  3494. 'RESPRO' vol ;
  3495. *
  3496. * End of procedure file GVOL
  3497. *
  3498. 'FINPROC' ;
  3499. *ENDPROCEDUR gvol
  3500. *BEGINPROCEDUR jetmod
  3501. ************************************************************************
  3502. * NOM : JETMOD
  3503. * DESCRIPTION :
  3504. *
  3505. *
  3506. *
  3507. * LANGAGE : GIBIANE-CAST3M
  3508. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  3509. * mél : gounand@semt2.smts.cea.fr
  3510. **********************************************************************
  3511. * VERSION : v1, ??/??/2007, version initiale
  3512. * HISTORIQUE : v1, ??/??/2007, création
  3513. * HISTORIQUE :
  3514. * HISTORIQUE :
  3515. ************************************************************************
  3516. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  3517. * en cas de modification de ce sous-programme afin de faciliter
  3518. * la maintenance !
  3519. ************************************************************************
  3520. *
  3521. *
  3522. 'DEBPROC' JETMOD ;
  3523. *'ARGUMENT' .... ;
  3524. 'SI' ('EGA' vdim 2) ;
  3525. 'SI' ('NEG' vmod 'AXIS') ;
  3526. nomdep = 'MOTS' 'UX' 'UY' ;
  3527. nomvit = nomdep ;
  3528. * nomvit = 'MOTS' 'VX' 'VY' ;
  3529. nomfor = 'MOTS' 'FX' 'FY' ;
  3530. nomqdm = 'MOTS' 'GX' 'GY' ;
  3531. 'SINON' ;
  3532. nomdep = 'MOTS' 'UR' 'UZ' ;
  3533. nomvit = nomdep ;
  3534. nomfor = 'MOTS' 'FR' 'FZ' ;
  3535. nomqdm = 'MOTS' 'GR' 'GZ' ;
  3536. 'FINSI' ;
  3537. 'SI' ('EGA' discp 'LINM') ;
  3538. nompre = 'MOTS' 'LX1' 'LX2' 'LX3' ;
  3539. 'SINON' ;
  3540. nompre = 'MOTS' 'LXP' ;
  3541. 'FINSI' ;
  3542. 'SINON' ;
  3543. nomdep = 'MOTS' 'UX' 'UY' 'UZ' ;
  3544. nomvit = nomdep ;
  3545. nomfor = 'MOTS' 'FX' 'FY' 'FZ' ;
  3546. nomqdm = 'MOTS' 'GX' 'GY' 'GZ' ;
  3547. 'SI' ('EGA' discp 'LINM') ;
  3548. nompre = 'MOTS' 'LX1' 'LX2' 'LX3' 'LX4' ;
  3549. 'SINON' ;
  3550. nompre = 'MOTS' 'LXP' ;
  3551. 'FINSI' ;
  3552. 'FINSI' ;
  3553. *
  3554. nomsca = 'MOTS' 'SCAL' ;
  3555. *
  3556. TDISC = 'TABLE' ;
  3557. TDISC . 'GEOM' = 'TABLE' ;
  3558. TDISC . 'GEOM' . 'DISC' = discg ;
  3559. TDISC . 'XN' = 'TABLE' ;
  3560. TDISC . 'XN' . 'DISC' = TDISC . 'GEOM' . 'DISC' ;
  3561. *TDISC . 'XN' . 'DISC' = 'LINB' ;
  3562. TDISC . 'XN' . 'NOMINC' = 'TABLE' ;
  3563. 'REPETER' idim vdim ;
  3564. TDISC . 'XN' . 'NOMINC' . &idim = 'MOTS' ('EXTRAIRE' nomdep &idim) ;
  3565. 'FIN' idim ;
  3566. TDISC . 'UN' = 'TABLE' ;
  3567. *TDISC . 'UN' . 'DISC' = TDISC . 'GEOM' . 'DISC' ;
  3568. TDISC . 'UN' . 'DISC' = discv ;
  3569. TDISC . 'UN' . 'NOMINC' = 'TABLE' ;
  3570. 'REPETER' idim vdim ;
  3571. TDISC . 'UN' . 'NOMINC' . &idim = 'MOTS' ('EXTRAIRE' nomvit &idim) ;
  3572. 'FIN' idim ;
  3573. TDISC . 'FN' = 'TABLE' ;
  3574. TDISC . 'FN' . 'DISC' = TDISC . 'GEOM' . 'DISC' ;
  3575. TDISC . 'FN' . 'NOMINC' = 'TABLE' ;
  3576. 'REPETER' idim vdim ;
  3577. TDISC . 'FN' . 'NOMINC' . &idim = 'MOTS' ('EXTRAIRE' nomfor &idim) ;
  3578. 'FIN' idim ;
  3579. TDISC . 'GN' = 'TABLE' ;
  3580. TDISC . 'GN' . 'DISC' = TDISC . 'GEOM' . 'DISC' ;
  3581. TDISC . 'GN' . 'NOMINC' = 'TABLE' ;
  3582. 'REPETER' idim vdim ;
  3583. TDISC . 'GN' . 'NOMINC' . &idim = 'MOTS' ('EXTRAIRE' nomqdm &idim) ;
  3584. 'FIN' idim ;
  3585. TDISC . 'PN' = 'TABLE' ;
  3586. TDISC . 'PN' . 'DISC' = discp ;
  3587. TDISC . 'PN' . 'NOMINC' = 'TABLE' ;
  3588. TDISC . 'PN' . 'NOMINC' . 1 = nompre ;
  3589. lmdisc = 'MOTS' 'CSTE' 'LINE' 'QUAF' ;
  3590. 'REPETER' iidisc ('DIME' lmdisc) ;
  3591. mdisc = 'EXTRAIRE' lmdisc &iidisc ;
  3592. tdisc . mdisc = 'TABLE' ;
  3593. tdisc . mdisc . 'DISC' = mdisc ;
  3594. tdisc . mdisc . 'NOMINC' = 'TABLE' ;
  3595. tdisc . mdisc . 'NOMINC' . 1 = nomsca ;
  3596. mdiscv = 'CHAINE' mdisc 'V' ;
  3597. tdisc . mdiscv = 'TABLE' ;
  3598. tdisc . mdiscv . 'DISC' = mdisc ;
  3599. tdisc . mdiscv . 'NOMINC' = 'TABLE' ;
  3600. 'REPETER' idim vdim ;
  3601. TDISC . mdiscv. 'NOMINC' . &idim =
  3602. 'MOTS' ('EXTRAIRE' nomdep &idim) ;
  3603. 'FIN' idim ;
  3604. 'FIN' iidisc ;
  3605. 'RESPRO' tdisc ;
  3606. *
  3607. * End of procedure file JETMOD
  3608. *
  3609. 'FINPROC' ;
  3610. *ENDPROCEDUR jetmod
  3611. *BEGINPROCEDUR log10
  3612. ************************************************************************
  3613. * NOM : LOG10
  3614. * DESCRIPTION : Log_10
  3615. *
  3616. *
  3617. *
  3618. * LANGAGE : GIBIANE-CAST3M
  3619. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  3620. * mél : gounand@semt2.smts.cea.fr
  3621. **********************************************************************
  3622. * VERSION : v1, 18/02/2003, version initiale
  3623. * HISTORIQUE : v1, 18/02/2003, création
  3624. * HISTORIQUE :
  3625. * HISTORIQUE :
  3626. ************************************************************************
  3627. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  3628. * en cas de modification de ce sous-programme afin de faciliter
  3629. * la maintenance !
  3630. ************************************************************************
  3631. *
  3632. *
  3633. 'DEBPROC' LOG10 ;
  3634. 'REPETER' bouc ;
  3635. ok = FAUX ;
  3636. 'ARGUMENT' fl/'FLOTTANT' ;
  3637. 'ARGUMENT' lr/'LISTREEL' ;
  3638. 'ARGUMENT' cp/'CHPOINT ' ;
  3639. 'ARGUMENT' cm/'MCHAML ' ;
  3640. 'SI' ('EXISTE' fl) ;
  3641. ok = VRAI ;
  3642. 'RESPRO' ('/' ('LOG' fl) ('LOG' 10.D0)) ;
  3643. 'FINSI' ;
  3644. 'SI' ('EXISTE' lr) ;
  3645. ok = VRAI ;
  3646. 'RESPRO' ('/' ('LOG' lr) ('LOG' 10.D0)) ;
  3647. 'FINSI' ;
  3648. 'SI' ('EXISTE' cp) ;
  3649. ok = VRAI ;
  3650. 'RESPRO' ('/' ('LOG' cp) ('LOG' 10.D0)) ;
  3651. 'FINSI' ;
  3652. 'SI' ('EXISTE' cm) ;
  3653. ok = VRAI ;
  3654. 'RESPRO' ('/' ('LOG' cm) ('LOG' 10.D0)) ;
  3655. 'FINSI' ;
  3656. 'SI' ('NON' ok) ;
  3657. 'QUITTER' bouc ;
  3658. 'FINSI' ;
  3659. 'FIN' bouc ;
  3660. *
  3661. * End of procedure file LOG10
  3662. *
  3663. 'FINPROC' ;
  3664. *ENDPROCEDUR log10
  3665. *BEGINPROCEDUR modulo
  3666. ************************************************************************
  3667. * NOM : MODULO
  3668. * DESCRIPTION : Calcule un entier modulo un autre...
  3669. *
  3670. *
  3671. *
  3672. * LANGAGE : GIBIANE-CAST3M
  3673. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  3674. * mél : gounand@semt2.smts.cea.fr
  3675. **********************************************************************
  3676. * VERSION : v1, 15/10/2002, version initiale
  3677. * HISTORIQUE : v1, 15/10/2002, création
  3678. * HISTORIQUE :
  3679. * HISTORIQUE :
  3680. ************************************************************************
  3681. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  3682. * en cas de modification de ce sous-programme afin de faciliter
  3683. * la maintenance !
  3684. ************************************************************************
  3685. *
  3686. *
  3687. 'DEBPROC' MODULO ;
  3688. 'ARGUMENT' i*'ENTIER' j*'ENTIER' ;
  3689. 'SI' ('EGA' j 0) ;
  3690. 'MESSAGE' 'Impossible de faire modulo 0' ;
  3691. 'ERREUR' 5 ;
  3692. 'SINON' ;
  3693. k=i '/' j ;
  3694. mod=i '-' ( k '*'j ) ;
  3695. 'RESPRO' mod ;
  3696. 'FINSI' ;
  3697. *
  3698. * End of procedure file MODULO
  3699. *
  3700. 'FINPROC' ;
  3701. *ENDPROCEDUR modulo
  3702. *BEGINPROCEDUR myent
  3703. ************************************************************************
  3704. * NOM : MYENT
  3705. * DESCRIPTION :
  3706. *
  3707. *
  3708. *
  3709. * LANGAGE : GIBIANE-CAST3M
  3710. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  3711. * mél : gounand@semt2.smts.cea.fr
  3712. **********************************************************************
  3713. * VERSION : v1, ??/??/2007, version initiale
  3714. * HISTORIQUE : v1, ??/??/2007, création
  3715. * HISTORIQUE :
  3716. * HISTORIQUE :
  3717. ************************************************************************
  3718. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  3719. * en cas de modification de ce sous-programme afin de faciliter
  3720. * la maintenance !
  3721. ************************************************************************
  3722. *
  3723. *
  3724. 'DEBPROC' MYENT ;
  3725. 'ARGUMENT' rr*'FLOTTANT' ;
  3726. 'SI' ('>EG' rr 0.) ;
  3727. ii = 'ENTIER' ('+' rr 0.5) ;
  3728. 'SINON' ;
  3729. ii = 'ENTIER' ('-' rr 0.5) ;
  3730. 'FINSI' ;
  3731. 'RESPRO' ii ;
  3732. *
  3733. * End of procedure file MYENT
  3734. *
  3735. 'FINPROC' ;
  3736. *ENDPROCEDUR myent
  3737. *BEGINPROCEDUR nortans
  3738. ************************************************************************
  3739. * NOM : NORTANS
  3740. * DESCRIPTION :
  3741. *
  3742. *
  3743. *
  3744. * LANGAGE : GIBIANE-CAST3M
  3745. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  3746. * mél : gounand@semt2.smts.cea.fr
  3747. **********************************************************************
  3748. * VERSION : v1, ??/??/2007, version initiale
  3749. * HISTORIQUE : v1, ??/??/2007, création
  3750. * HISTORIQUE :
  3751. * HISTORIQUE :
  3752. ************************************************************************
  3753. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  3754. * en cas de modification de ce sous-programme afin de faciliter
  3755. * la maintenance !
  3756. ************************************************************************
  3757. *
  3758. *
  3759. 'DEBPROC' NORTANS ;
  3760. 'ARGUMENT' vno*'CHPOINT' ;
  3761. 'REPETER' bcl ;
  3762. 'ARGUMENT' chpo/'CHPOINT' ;
  3763. 'SI' ('EXISTE' chpo) ;
  3764. * chpo + vnor * 0 pour le cas des chpoints vides
  3765. chpon = PSCAL ('+' chpo ('*' vnor 0.))
  3766. vnor nomdep nomdep ;
  3767. * 'LISTE' chpo ;
  3768. * 'LISTE' chpon ;
  3769. * 'LISTE' vnor ;
  3770. chponn = '*' chpon vnor ;
  3771. chpott = '-' chpo chponn ;
  3772. chpot = '**' ('PSCAL' chpott chpott nomdep nomdep) 0.5D0 ;
  3773. 'RESPRO' chpon chpot ;
  3774. 'SINON' ;
  3775. 'QUITTER' bcl ;
  3776. 'FINSI' ;
  3777. 'FIN' bcl ;
  3778. *
  3779. * End of procedure file NORTANS
  3780. *
  3781. 'FINPROC' ;
  3782. *ENDPROCEDUR nortans
  3783. *BEGINPROCEDUR projsysc
  3784. ************************************************************************
  3785. * NOM : PROJSYSC
  3786. * DESCRIPTION : Calcul matrice et second membre projetés suivant
  3787. * un champ de directions données
  3788. *
  3789. * Project a linear system with respect to a given
  3790. * vector field
  3791. *
  3792. *
  3793. *
  3794. * LANGAGE : GIBIANE-CAST3M
  3795. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  3796. * mél : gounand@semt2.smts.cea.fr
  3797. **********************************************************************
  3798. * VERSION : v1, 22/04/2011, version initiale
  3799. * HISTORIQUE : v1, 22/04/2011, création
  3800. * HISTORIQUE :
  3801. * HISTORIQUE :
  3802. ************************************************************************
  3803. *
  3804. *
  3805. 'DEBPROC' PROJSYSC ;
  3806. 'ARGUMENT' tdisc*'TABLE' ;
  3807. 'ARGUMENT' vnorn*'CHPOINT' ;
  3808. 'ARGUMENT' ktgra*'RIGIDITE' ;
  3809. 'ARGUMENT' fpgra*'CHPOINT' ;
  3810. 'ARGUMENT' kvol/'CHPOINT' ;
  3811. lcnt = 'EXISTE' kvol ;
  3812. 'SI' lcnt ;
  3813. 'ARGUMENT' dvol*'FLOTTANT' ;
  3814. 'FINSI' ;
  3815. vdim = 'VALEUR' 'DIME' ;
  3816. NOMVIT = @STBL (TDISC . 'XN' . 'NOMINC') ;
  3817. fpgran = 'PSCAL' fpgra vnorn nomvit nomvit ;
  3818. * Condensation de la matrice
  3819. 'SI' lmatrik ;
  3820. knord = 'KOPS' 'MATDIAGO' vnorn 'MATRIK' ;
  3821. 'SINON' ;
  3822. knord = 'KOPS' 'MATDIAGO' vnorn ;
  3823. knord = 'CHANGER' 'INCO' knord nomvit nomvit
  3824. nomfor nomvit ;
  3825. * knordk= 'KOPS' 'MATDIAGO' vnorn 'MATRIK' ;
  3826. 'FINSI' ;
  3827. 'SI' ('EGA' vdim 2) ;
  3828. nomscal = 'MOTS' 'SCAL' 'SCAL' ;
  3829. 'SINON' ;
  3830. nomscal = 'MOTS' 'SCAL' 'SCAL' 'SCAL' ;
  3831. 'FINSI' ;
  3832. knor = 'CHANGER' 'INCO' knord nomvit nomscal nomvit nomvit ;
  3833. knort = 'CHANGER' 'INCO' knord nomvit nomvit nomvit nomscal ;
  3834. 'SI' lmatrik ;
  3835. ktgrak = 'KOPS' 'RIMA' ktgra ;
  3836. 'SINON' ;
  3837. ktgrak = ktgra ;
  3838. 'FINSI' ;
  3839. * 'MESSAGE' 'ktgrak' ;
  3840. * 'LISTE' ('EXTRAIRE' ktgrak 'COMP') ;
  3841. * 'LISTE' ('EXTRAIRE' ktgrak 'COMP' 'DUAL') ;
  3842. * 'MESSAGE' 'knort' ;
  3843. * 'LISTE' ('EXTRAIRE' knort 'COMP') ;
  3844. * 'LISTE' ('EXTRAIRE' knort 'COMP' 'DUAL') ;
  3845. ktg1 = 'KOPS' 'CMCT' ktgrak knort ;
  3846. * 'MESSAGE' 'ktg1' ;
  3847. * 'LISTE' ('EXTRAIRE' ktg1 'COMP') ;
  3848. * 'LISTE' ('EXTRAIRE' ktg1 'COMP' 'DUAL') ;
  3849. ktg2 = 'KOPS' 'TRANSPOS' ktg1 ;
  3850. * 'MESSAGE' 'ktg2' ;
  3851. * 'LISTE' ('EXTRAIRE' ktg2 'COMP') ;
  3852. * 'LISTE' ('EXTRAIRE' ktg2 'COMP' 'DUAL') ;
  3853. ktg3 = 'KOPS' 'CMCT' knort ktg2 ;
  3854. * 'MESSAGE' 'ktg3' ;
  3855. * 'LISTE' ('EXTRAIRE' ktg3 'COMP') ;
  3856. * 'LISTE' ('EXTRAIRE' ktg3 'COMP' 'DUAL') ;
  3857. ktot = ktg3 ;
  3858. ftot = fpgran ;
  3859. 'SI' lcnt ;
  3860. ktvol = 'PSCAL' kvol vnorn nomvit nomvit ;
  3861. ktv = rela ('NOMC' 'T' ktvol) ;
  3862. smbvol = 'DEPIMPOSE' ktv dvol ;
  3863. 'SI' lmatrik ;
  3864. ktv = 'KOPS' 'RIMA' ktv ;
  3865. 'FINSI' ;
  3866. lpr1 = 'MOTS' 'T' 'LX' ; l2 = 'MOTS' 'SCAL' 'LX' ;
  3867. ldu1 = 'MOTS' 'Q' 'FLX' ;
  3868. ktv = 'CHANGER' 'INCO' ktv lpr1 l2 ldu1 l2 ;
  3869. smbvol = 'NOMC' ldu1 l2 smbvol ;
  3870. ktot = ktot 'ET' ktv ;
  3871. ftot = ftot '+' smbvol ;
  3872. 'FINSI' ;
  3873. 'RESPRO' ktot ftot ;
  3874. *
  3875. * End of procedure file PROJSYSC
  3876. *
  3877. 'FINPROC' ;
  3878. *ENDPROCEDUR projsysc
  3879. *BEGINPROCEDUR quafme
  3880. ************************************************************************
  3881. * NOM : QUAFME
  3882. * DESCRIPTION :
  3883. *
  3884. *
  3885. *
  3886. * LANGAGE : GIBIANE-CAST3M
  3887. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  3888. * mél : gounand@semt2.smts.cea.fr
  3889. **********************************************************************
  3890. * VERSION : v1, 01/12/2004, version initiale
  3891. * HISTORIQUE : v1, 01/12/2004, création
  3892. * HISTORIQUE :
  3893. * HISTORIQUE :
  3894. ************************************************************************
  3895. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  3896. * en cas de modification de ce sous-programme afin de faciliter
  3897. * la maintenance !
  3898. ************************************************************************
  3899. *
  3900. *
  3901. 'DEBPROC' QUAFME ;
  3902. 'REPETER' bcl ;
  3903. 'ARGUMENT' mquad/'MAILLAGE' ;
  3904. 'SI' ('EXISTE' mquad) ;
  3905. mquaf = 'CHANGER' mquad 'QUAF' ;
  3906. * mlin = 'CHANGER' mquad 'LINEAIRE' ;
  3907. 'RESPRO' mquaf ;
  3908. 'SINON' ;
  3909. 'QUITTER' bcl ;
  3910. 'FINSI' ;
  3911. 'FIN' bcl ;
  3912. 'FINPROC' ;
  3913. *
  3914. * End of procedure file QUAFME
  3915. *
  3916. *ENDPROCEDUR quafme
  3917. *BEGINPROCEDUR surchpo
  3918. ************************************************************************
  3919. * NOM : SURCHPO
  3920. * DESCRIPTION : Surcharge un chpoint par un autre
  3921. *
  3922. *
  3923. *
  3924. * LANGAGE : GIBIANE-CAST3M
  3925. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  3926. * mél : gounand@semt2.smts.cea.fr
  3927. **********************************************************************
  3928. * VERSION : v1, 17/05/2006, version initiale
  3929. * HISTORIQUE : v1, 17/05/2006, création
  3930. * HISTORIQUE :
  3931. * HISTORIQUE :
  3932. ************************************************************************
  3933. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  3934. * en cas de modification de ce sous-programme afin de faciliter
  3935. * la maintenance !
  3936. ************************************************************************
  3937. *
  3938. *
  3939. 'DEBPROC' SURCHPO ;
  3940. 'ARGUMENT' chpo1*'CHPOINT' ;
  3941. 'ARGUMENT' chpo2*'CHPOINT' ;
  3942. tchpo = 'TABLE' ;
  3943. *
  3944. * Extraction des noms de composantes
  3945. *
  3946. lncomp = 'EXTRAIRE' chpo1 'COMP' ;
  3947. dlncomp = 'DIME' lncomp ;
  3948. 'SI' ('EGA' dlncomp 0) ;
  3949. 'RESPRO' chpo2 ;
  3950. 'QUITTER' SURCHPO ;
  3951. 'FINSI' ;
  3952. lncomp2 = 'EXTRAIRE' chpo2 'COMP' ;
  3953. 'REPETER' iicomp dlncomp ;
  3954. icomp = &iicomp ;
  3955. com = 'EXTRAIRE' lncomp icomp ;
  3956. ccom = 'EXCO' com chpo1 com ;
  3957. 'SI' ('EGA' (ISINLIS com lncomp2) 0) ;
  3958. tchpo . icomp = ccom ;
  3959. 'SINON' ;
  3960. ccom2 = 'EXCO' com chpo2 com ;
  3961. mcc = 'EXTRAIRE' ccom 'MAIL' ;
  3962. mcc2 = 'EXTRAIRE' ccom2 'MAIL' ;
  3963. mr = 'DIFF' mcc mcc2 ;
  3964. ncom = '+' ('REDU' ccom mr)
  3965. ccom2 ;
  3966. tchpo . icomp = ncom ;
  3967. 'FINSI' ;
  3968. 'FIN' iicomp ;
  3969. 'REPETER' iicomp dlncomp ;
  3970. icomp = &iicomp ;
  3971. chpo = tchpo . icomp ;
  3972. 'SI' ('EGA' icomp 1) ;
  3973. chpot = chpo ;
  3974. 'SINON' ;
  3975. chpot = chpot '+' chpo ;
  3976. 'FINSI' ;
  3977. 'FIN' iicomp ;
  3978. 'RESPRO' chpot ;
  3979. *
  3980. * End of procedure file SURCHPO
  3981. *
  3982. 'FINPROC' ;
  3983. *ENDPROCEDUR surchpo
  3984. *BEGINPROCEDUR trvec
  3985. ************************************************************************
  3986. * NOM : TRVEC
  3987. * DESCRIPTION : Trace des champs de vecteurs.
  3988. * Utile pour tracer des bilans de forces
  3989. *
  3990. * Display vector fields.
  3991. * Useful for visualization of force balance.
  3992. *
  3993. *
  3994. *
  3995. * LANGAGE : GIBIANE-CAST3M
  3996. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  3997. * mél : gounand@semt2.smts.cea.fr
  3998. **********************************************************************
  3999. * VERSION : v1, 22/04/2011, version initiale
  4000. * HISTORIQUE : v1, 22/04/2011, création
  4001. * HISTORIQUE :
  4002. * HISTORIQUE :
  4003. ************************************************************************
  4004. *
  4005. *
  4006. 'DEBPROC' TRVEC ;
  4007. *'ARGUMENT' tdisc*'TABLE' ;
  4008. *'ARGUMENT' motdom*'MOT' ;
  4009. 'ARGUMENT' tdom*'MAILLAGE' ;
  4010. *
  4011. tvec = 'TABLE' ; ttit = 'TABLE' ;
  4012. i = 0 ;
  4013. lcoul = 'MOTS' 'JAUN' 'ROUG' 'BLAN' 'TURQ' 'VERT' 'OLIV'
  4014. 'AZUR' 'ORAN' 'VIOL' 'GRIS' 'OCEA' ;
  4015. *
  4016. 'REPETER' livec ;
  4017. 'SI' ('EGA' i 0) ;
  4018. 'ARGUMENT' ccvec*'CHPOINT' ;
  4019. 'SINON' ;
  4020. 'ARGUMENT' ccvec/'CHPOINT' ;
  4021. 'FINSI' ;
  4022. 'SI' ('EXISTE' ccvec) ;
  4023. 'ARGUMENT' ttvec*'MOT' ;
  4024. 'SINON' ;
  4025. 'QUITTER' livec ;
  4026. 'FINSI' ;
  4027. i = '+' i 1 ;
  4028. * 'MESSAGE' ('CHAINE' 'i=' i) ;
  4029. * 'LISTE' ccvec ;
  4030. * 'LISTE' tvec ;
  4031. tvec . i = ccvec ;
  4032. ttit . i = ttvec ;
  4033. 'FIN' livec ;
  4034. 'ARGUMENT' echv/'FLOTTANT' ;
  4035. 'ARGUMENT' lnclk/'LOGIQUE' ;
  4036. 'SI' ('NON' ('EXISTE' lnclk)) ;
  4037. lnclk = faux ;
  4038. 'FINSI' ;
  4039. *
  4040. lmax = 'PROG' ;
  4041. 'REPETER' ii i ;
  4042. mm = 'MAXIMUM' (tvec . &ii) 'ABS' ;
  4043. lmax = 'ET' lmax ('PROG' mm) ;
  4044. 'FIN' ii ;
  4045. mm = '+' ('MAXIMUM' lmax) 1.D-60 ;
  4046. 'SI' ('NON' ('EXISTE' echv)) ;
  4047. vmodo = 'EGA' ('VALEUR' 'MODE') 'AXIS' ;
  4048. 'SI' vmodo ; 'OPTI' 'MODE' 'PLAN' ; 'FINSI' ;
  4049. ctail = gmass2 ('CHANGER' tdom 'QUAF') tdisc
  4050. 'NPRI' 'CSTE' 'FPRI' 1. 'NDUA' 'CSTE' 'FDUA' 1. ;
  4051. * 'LISTE' ctail ;
  4052. 'SI' vmodo ; 'OPTI' 'MODE' 'AXIS' ; 'FINSI' ;
  4053. vdim = 'VALEUR' 'DIME' ;
  4054. dimm = DEADUTIL 'DIMM' tdom ;
  4055. * ctail = '**' ctail ('/' 1. ('-' vdim 1)) ;
  4056. ctail = '**' ctail ('/' 1. dimm) ;
  4057. tail = '**' ('*' ('MAXIMUM' ctail) ('MINIMUM' ctail)) 0.5 ;
  4058. *'LISTE' tail ;
  4059. *'LISTE' mm ;
  4060. echv = '/' ('*' 0.9 tail) mm ;
  4061. 'FINSI' ;
  4062. tit = 'CHAINE' 'Max. =' (formar mm 2) ;
  4063. *'MESSAGE' ('CHAINE' 'mm=' mm) ;
  4064. 'REPETER' ii i ;
  4065. cou = EXMOMOD lcoul &ii ;
  4066. tvec . &ii = 'VECT' (tvec . &ii) echv 'DEPL' cou ;
  4067. tit = 'CHAINE' tit ' ' cou '=' (ttit . &ii) ;
  4068. 'FIN' ii ;
  4069. 'SI' lnclk ;
  4070. 'TRACER' (@stbl tvec) tdom 'TITR' tit 'NCLK' ;
  4071. 'SINON' ;
  4072. 'TRACER' (@stbl tvec) tdom 'TITR' tit ;
  4073. 'FINSI' ;
  4074. *
  4075. * End of procedure file TRVEC
  4076. *
  4077. 'FINPROC' ;
  4078. *ENDPROCEDUR trvec
  4079. *BEGINPROCEDUR tsurktan
  4080. ************************************************************************
  4081. * NOM : TSURKTAN
  4082. * DESCRIPTION : La matrice tangente pour la tension de surface
  4083. *
  4084. *
  4085. *
  4086. * LANGAGE : GIBIANE-CAST3M
  4087. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  4088. * mél : gounand@semt2.smts.cea.fr
  4089. **********************************************************************
  4090. * VERSION : v1, 17/01/2007, version initiale
  4091. * HISTORIQUE : v1, 17/01/2007, création
  4092. * HISTORIQUE :
  4093. * HISTORIQUE :
  4094. ************************************************************************
  4095. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  4096. * en cas de modification de ce sous-programme afin de faciliter
  4097. * la maintenance !
  4098. ************************************************************************
  4099. *
  4100. *
  4101. 'DEBPROC' TSURKTAN ;
  4102. 'ARGUMENT' _mt*'MAILLAGE' ;
  4103. 'ARGUMENT' gdisc*'MOT' ;
  4104. 'ARGUMENT' methgau*'MOT' ;
  4105. 'ARGUMENT' dppri*'LISTMOTS' ;
  4106. 'ARGUMENT' dpdua*'LISTMOTS' ;
  4107. *
  4108. dpdis = gdisc ;
  4109. *
  4110. idim = 'VALEUR' 'DIME' ;
  4111. vdim = DEADUTIL 'DIMM' _mt ;
  4112. laxi = DEADUTIL 'AXI?' ;
  4113. lsph = DEADUTIL 'SPH?' ;
  4114. *
  4115. loi = 'CHAINE' 'TSUJ' ;
  4116. loij = 'CHAINE' 'TSU' ;
  4117. *
  4118. 'ARGUMENT' coef/'FLOTTANT' ;
  4119. 'SI' ('NON' ('EXISTE' coef)) ;
  4120. 'ARGUMENT' coef2/'CHPOINT ' ;
  4121. 'SI' ('NON' ('EXISTE' coef2)) ;
  4122. 'ERREUR' 'Il faut donner un coef FLOTTANT ou CHPOINT' ;
  4123. 'SINON' ;
  4124. coef = coef2 ;
  4125. 'ARGUMENT' discc*'MOT ' ;
  4126. 'FINSI' ;
  4127. 'SINON' ;
  4128. discc = 'CSTE' ;
  4129. 'FINSI' ;
  4130. *
  4131. 'ARGUMENT' jaco/'ENTIER' ;
  4132. 'SI' ('NON' ('EXISTE' jaco)) ;
  4133. jaco = 1 ;
  4134. dir1 = VRAI ;
  4135. 'FINSI' ;
  4136. 'SI' ('OU' ('EGA' jaco 2) ('EGA' jaco 3)) ;
  4137. 'ARGUMENT' idir/'ENTIER' ;
  4138. 'SI' ('EXISTE' idir) ;
  4139. ldir = 'LECT' idir ;
  4140. 'SI' ('EGA' idir 1) ;
  4141. dir1 = VRAI ;
  4142. 'FINSI' ;
  4143. 'SINON' ;
  4144. 'ARGUMENT' ldir/'LISTENTI' ;
  4145. 'SI' ('NON' ('EXISTE' ldir)) ;
  4146. ldir = 'LECT' 1 'PAS' 1 idim ;
  4147. dir1 = VRAI ;
  4148. 'FINSI' ;
  4149. 'FINSI' ;
  4150. 'FINSI' ;
  4151. 'ARGUMENT' lterm/'LISTENTI' ;
  4152. llterm = 'EXISTE' lterm ;
  4153. 'SI' llterm ;
  4154. dlterm = 'DIME' lterm ;
  4155. 'SINON' ;
  4156. dlterm = 1 ;
  4157. 'FINSI' ;
  4158. *
  4159. * Calcul du jacobien complet (jaco = 1)
  4160. *
  4161. 'SI' ('EGA' jaco 1) ;
  4162. numop = '*' ('**' vdim 2) ('**' idim 2) ;
  4163. numop = '*' numop dlterm ;
  4164. 'SI' ('OU' laxi lsph) ;
  4165. numop = '+' numop ('*' (vdim '*' idim) 2) ;
  4166. 'FINSI' ;
  4167. 'SI' lsph ;
  4168. numop = '+' numop 1 ;
  4169. 'FINSI' ;
  4170. numder = vdim ;
  4171. numvar = idim ;
  4172. numdat = 0 ;
  4173. numcof = 0 ;
  4174. *
  4175. A = ININLIN numop numvar numdat numcof numder ;
  4176. numdat = 1 ;
  4177. numcof = numop ;
  4178. B = ININLIN numop numvar numdat numcof numder ;
  4179. 'REPETER' ivar numvar ;
  4180. A . 'VAR' . &ivar . 'NOMDDL' = 'MOTS' ('EXTRAIRE' dppri &ivar) ;
  4181. A . 'VAR' . &ivar . 'DISC' = dpdis ;
  4182. B . 'VAR' . &ivar . 'NOMDDL' = 'MOTS' ('EXTRAIRE' dpdua &ivar) ;
  4183. B . 'VAR' . &ivar . 'DISC' = dpdis ;
  4184. 'FIN' ivar ;
  4185. iop = 0 ;
  4186. 'REPETER' h dlterm ;
  4187. 'REPETER' i idim ;
  4188. 'REPETER' j vdim ;
  4189. 'REPETER' k idim ;
  4190. 'REPETER' l vdim ;
  4191. iop = iop '+' 1 ;
  4192. A . iop . &i . &j = 'LECT' ;
  4193. 'SI' llterm ;
  4194. nl = 'EXTRAIRE' lterm &h ;
  4195. nomloi = 'CHAINE' loij nl &i &j &k &l ;
  4196. 'SINON' ;
  4197. nomloi = 'CHAINE' loi &i &j &k &l ;
  4198. 'FINSI' ;
  4199. * 'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
  4200. B . 'COF' . iop . 'COMPOR' = nomloi ;
  4201. B . 'COF' . iop . 'LDAT' = 'LECT' 1 ;
  4202. B . iop . &k . &l = 'LECT' iop ;
  4203. 'FIN' l ;
  4204. 'FIN' k ;
  4205. 'FIN' j ;
  4206. 'FIN' i ;
  4207. 'FIN' h ;
  4208. 'SI' ('OU' laxi lsph) ;
  4209. 'REPETER' i idim ;
  4210. 'REPETER' j vdim ;
  4211. iop = iop '+' 1 ;
  4212. A . iop . &i . &j = 'LECT' ;
  4213. nomloi = 'CHAINE' loi &i &j '10' ;
  4214. * 'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
  4215. B . 'COF' . iop . 'COMPOR' = nomloi ;
  4216. B . 'COF' . iop . 'LDAT' = 'LECT' 1 ;
  4217. B . iop . 1 . 0 = 'LECT' iop ;
  4218. 'FIN' j ;
  4219. 'FIN' i ;
  4220. 'REPETER' k idim ;
  4221. 'REPETER' l vdim ;
  4222. iop = iop '+' 1 ;
  4223. A . iop . 1 . 0 = 'LECT' ;
  4224. nomloi = 'CHAINE' loi '10' &k &l ;
  4225. * 'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
  4226. B . 'COF' . iop . 'COMPOR' = nomloi ;
  4227. B . 'COF' . iop . 'LDAT' = 'LECT' 1 ;
  4228. B . iop . &k . &l = 'LECT' iop ;
  4229. 'FIN' l ;
  4230. 'FIN' k ;
  4231. 'FINSI' ;
  4232. 'SI' lsph ;
  4233. iop = iop '+' 1 ;
  4234. A . iop . 1 . 0 = 'LECT' ;
  4235. nomloi = 'CHAINE' loi '1010' ;
  4236. * 'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
  4237. B . 'COF' . iop . 'COMPOR' = nomloi ;
  4238. B . 'COF' . iop . 'LDAT' = 'LECT' 1 ;
  4239. B . iop . 1 . 0 = 'LECT' iop ;
  4240. 'FINSI' ;
  4241. 'FINSI' ;
  4242. 'SI' ('EGA' jaco 2) ;
  4243. nldir = 'DIME' ldir ;
  4244. numop = '*' nldir ('**' vdim 2) ;
  4245. 'SI' dir1 ;
  4246. 'SI' ('OU' laxi lsph) ;
  4247. numop = '+' numop ('*' vdim 2) ;
  4248. 'FINSI' ;
  4249. 'SI' lsph ;
  4250. numop = '+' numop 1 ;
  4251. 'FINSI' ;
  4252. 'FINSI' ;
  4253. *
  4254. numder = vdim ;
  4255. numvar = idim ;
  4256. numdat = 0 ;
  4257. numcof = 0 ;
  4258. *
  4259. A = ININLIN numop numvar numdat numcof numder ;
  4260. numdat = 1 ;
  4261. numcof = numop ;
  4262. B = ININLIN numop numvar numdat numcof numder ;
  4263. 'REPETER' ivar numvar ;
  4264. A . 'VAR' . &ivar . 'NOMDDL' = 'MOTS' ('EXTRAIRE' dppri &ivar) ;
  4265. A . 'VAR' . &ivar . 'DISC' = dpdis ;
  4266. B . 'VAR' . &ivar . 'NOMDDL' = 'MOTS' ('EXTRAIRE' dpdua &ivar) ;
  4267. B . 'VAR' . &ivar . 'DISC' = dpdis ;
  4268. 'FIN' ivar ;
  4269. iop = 0 ;
  4270. 'REPETER' i nldir ;
  4271. idir = 'EXTRAIRE' ldir &i ;
  4272. 'REPETER' j vdim ;
  4273. 'REPETER' l vdim ;
  4274. iop = iop '+' 1 ;
  4275. A . iop . idir . &j = 'LECT' ;
  4276. nomloi = 'CHAINE' loi idir &j idir &l ;
  4277. * 'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
  4278. B . 'COF' . iop . 'COMPOR' = nomloi ;
  4279. B . 'COF' . iop . 'LDAT' = 'LECT' 1 ;
  4280. B . iop . idir . &l = 'LECT' iop ;
  4281. 'FIN' l ;
  4282. 'FIN' j ;
  4283. 'FIN' i ;
  4284. 'SI' dir1 ;
  4285. 'SI' ('OU' laxi lsph) ;
  4286. 'REPETER' j vdim ;
  4287. iop = iop '+' 1 ;
  4288. A . iop . 1 . &j = 'LECT' ;
  4289. nomloi = 'CHAINE' loi '1' &j '10' ;
  4290. * 'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
  4291. B . 'COF' . iop . 'COMPOR' = nomloi ;
  4292. B . 'COF' . iop . 'LDAT' = 'LECT' 1 ;
  4293. B . iop . 1 . 0 = 'LECT' iop ;
  4294. 'FIN' j ;
  4295. 'REPETER' l vdim ;
  4296. iop = iop '+' 1 ;
  4297. A . iop . 1 . 0 = 'LECT' ;
  4298. nomloi = 'CHAINE' loi '101' &l ;
  4299. * 'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
  4300. B . 'COF' . iop . 'COMPOR' = nomloi ;
  4301. B . 'COF' . iop . 'LDAT' = 'LECT' 1 ;
  4302. B . iop . 1 . &l = 'LECT' iop ;
  4303. 'FIN' l ;
  4304. 'FINSI' ;
  4305. 'SI' lsph ;
  4306. iop = iop '+' 1 ;
  4307. A . iop . 1 . 0 = 'LECT' ;
  4308. nomloi = 'CHAINE' loi '1010' ;
  4309. * 'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
  4310. B . 'COF' . iop . 'COMPOR' = nomloi ;
  4311. B . 'COF' . iop . 'LDAT' = 'LECT' 1 ;
  4312. B . iop . 1 . 0 = 'LECT' iop ;
  4313. 'FINSI' ;
  4314. 'FINSI' ;
  4315. 'FINSI' ;
  4316. *
  4317. 'SI' ('EGA' jaco 3) ;
  4318. nldir = 'DIME' ldir ;
  4319. * numop = '**' vdim 2 ;
  4320. numop = '*' nldir vdim ;
  4321. 'SI' ('ET' dir1 lsph) ;
  4322. numop = '+' numop 1 ;
  4323. 'FINSI' ;
  4324. *
  4325. numder = vdim ;
  4326. numvar = idim ;
  4327. numdat = 0 ;
  4328. numcof = 0 ;
  4329. *
  4330. A = ININLIN numop numvar numdat numcof numder ;
  4331. numdat = 1 ;
  4332. numcof = numop ;
  4333. B = ININLIN numop numvar numdat numcof numder ;
  4334. 'REPETER' ivar numvar ;
  4335. A . 'VAR' . &ivar . 'NOMDDL' = 'MOTS' ('EXTRAIRE' dppri &ivar) ;
  4336. A . 'VAR' . &ivar . 'DISC' = dpdis ;
  4337. B . 'VAR' . &ivar . 'NOMDDL' = 'MOTS' ('EXTRAIRE' dpdua &ivar) ;
  4338. B . 'VAR' . &ivar . 'DISC' = dpdis ;
  4339. 'FIN' ivar ;
  4340. iop = 0 ;
  4341. 'REPETER' i nldir ;
  4342. idir = 'EXTRAIRE' ldir &i ;
  4343. 'REPETER' j vdim ;
  4344. iop = iop '+' 1 ;
  4345. A . iop . idir . &j = 'LECT' ;
  4346. nomloi = 'CHAINE' loi idir &j idir &j ;
  4347. * 'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
  4348. B . 'COF' . iop . 'COMPOR' = nomloi ;
  4349. B . 'COF' . iop . 'LDAT' = 'LECT' 1 ;
  4350. B . iop . idir . &j = 'LECT' iop ;
  4351. 'FIN' j ;
  4352. 'FIN' i ;
  4353. 'SI' ('ET' dir1 lsph) ;
  4354. iop = iop '+' 1 ;
  4355. A . iop . 1 . 0 = 'LECT' ;
  4356. nomloi = 'CHAINE' loi '1010' ;
  4357. * 'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
  4358. B . 'COF' . iop . 'COMPOR' = nomloi ;
  4359. B . 'COF' . iop . 'LDAT' = 'LECT' 1 ;
  4360. B . iop . 1 . 0 = 'LECT' iop ;
  4361. 'FINSI' ;
  4362. 'FINSI' ;
  4363. *
  4364. * Partie commune
  4365. *
  4366. B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  4367. B . 'DAT' . 1 . 'DISC' = discc ;
  4368. B . 'DAT' . 1 . 'VALEUR' = coef ;
  4369. *
  4370. jac = 'NLIN' gdisc _mt A B 'EREF' methgau ;
  4371. *
  4372. 'RESPRO' jac ;
  4373. *
  4374. * End of procedure file TSURKTAN
  4375. *
  4376. 'FINPROC' ;
  4377. *ENDPROCEDUR tsurktan
  4378. *BEGINPROCEDUR tsurresi
  4379. ************************************************************************
  4380. * NOM : TSURRESI
  4381. * DESCRIPTION : Le résidu à annuler pour la tension de surface
  4382. *
  4383. *
  4384. *
  4385. * LANGAGE : GIBIANE-CAST3M
  4386. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  4387. * mél : gounand@semt2.smts.cea.fr
  4388. **********************************************************************
  4389. * VERSION : v1, 17/01/2007, version initiale
  4390. * HISTORIQUE : v1, 17/01/2007, création
  4391. * HISTORIQUE :
  4392. * HISTORIQUE :
  4393. ************************************************************************
  4394. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  4395. * en cas de modification de ce sous-programme afin de faciliter
  4396. * la maintenance !
  4397. ************************************************************************
  4398. *
  4399. *
  4400. 'DEBPROC' TSURRESI ;
  4401. 'ARGUMENT' _mt*'MAILLAGE' ;
  4402. 'ARGUMENT' gdisc*'MOT' ;
  4403. 'ARGUMENT' methgau*'MOT' ;
  4404. 'ARGUMENT' dpdua*'LISTMOTS' ;
  4405. *
  4406. dpdis = gdisc ;
  4407. *
  4408. idim = 'VALEUR' 'DIME' ;
  4409. vdim = DEADUTIL 'DIMM' _mt ;
  4410. laxi = DEADUTIL 'AXI?' ;
  4411. lsph = DEADUTIL 'SPH?' ;
  4412. *
  4413. loi = 'CHAINE' 'TSUR' ;
  4414. *
  4415. 'ARGUMENT' coef/'FLOTTANT' ;
  4416. 'SI' ('NON' ('EXISTE' coef)) ;
  4417. 'ARGUMENT' coef2/'CHPOINT ' ;
  4418. 'SI' ('NON' ('EXISTE' coef2)) ;
  4419. 'ERREUR' 'Il faut donner un coef FLOTTANT ou CHPOINT' ;
  4420. 'SINON' ;
  4421. coef = coef2 ;
  4422. 'ARGUMENT' discc*'MOT ' ;
  4423. 'FINSI' ;
  4424. 'SINON' ;
  4425. discc = 'CSTE' ;
  4426. 'FINSI' ;
  4427. *
  4428. dir1 = FAUX ;
  4429. 'ARGUMENT' idir/'ENTIER' ;
  4430. 'SI' ('EXISTE' idir) ;
  4431. ldir = 'LECT' idir ;
  4432. 'SI' ('EGA' idir 1) ;
  4433. dir1 = VRAI ;
  4434. 'FINSI' ;
  4435. 'SINON' ;
  4436. 'ARGUMENT' ldir/'LISTENTI' ;
  4437. 'SI' ('NON' ('EXISTE' ldir)) ;
  4438. ldir = 'LECT' 1 'PAS' 1 idim ;
  4439. dir1 = VRAI ;
  4440. 'FINSI' ;
  4441. 'FINSI' ;
  4442. *
  4443. * Calcul du résidu
  4444. *
  4445. nldir = 'DIME' ldir ;
  4446. *
  4447. numop = '*' nldir vdim ;
  4448. term1 = ('OU' laxi lsph) 'ET' dir1 ;
  4449. 'SI' term1 ;
  4450. numop = '+' numop 1 ;
  4451. 'FINSI' ;
  4452. numder = vdim ;
  4453. numvar = 1 ;
  4454. numdat = 0 ;
  4455. numcof = 0 ;
  4456. *
  4457. A = ININLIN numop numvar numdat numcof numder ;
  4458. A . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
  4459. A . 'VAR' . 1 . 'DISC' = 'CSTE' ;
  4460. A . 'VAR' . 1 . 'VALEUR' = 1.D0 ;
  4461. *
  4462. numvar = idim ;
  4463. numdat = 1 ;
  4464. numcof = numop ;
  4465. B = ININLIN numop numvar numdat numcof numder ;
  4466. 'REPETER' ivar numvar ;
  4467. B . 'VAR' . &ivar . 'NOMDDL' = 'MOTS' ('EXTRAIRE' dpdua &ivar) ;
  4468. B . 'VAR' . &ivar . 'DISC' = dpdis ;
  4469. 'FIN' ivar ;
  4470. *
  4471. B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  4472. B . 'DAT' . 1 . 'DISC' = discc ;
  4473. B . 'DAT' . 1 . 'VALEUR' = coef ;
  4474. *
  4475. iop = 0 ;
  4476. 'REPETER' k nldir ;
  4477. idir = 'EXTRAIRE' ldir &k ;
  4478. 'REPETER' l vdim ;
  4479. iop = '+' iop 1 ;
  4480. A . iop . 1 . 0 = 'LECT' ;
  4481. nomloi = 'CHAINE' loi idir &l ;
  4482. * 'MESSAGE' ('CHAINE' 'Nomloi=' nomloi) ;
  4483. B . 'COF' . iop . 'COMPOR' = nomloi ;
  4484. B . 'COF' . iop . 'LDAT' = 'LECT' 1 ;
  4485. B . iop . idir . &l = 'LECT' iop ;
  4486. 'FIN' l ;
  4487. 'FIN' k ;
  4488. * 'LISTE' A ; 'LISTE' iop ;
  4489. 'SI' term1 ;
  4490. iop = '+' iop 1 ;
  4491. A . iop . 1 . 0 = 'LECT' ;
  4492. nomloi = 'CHAINE' loi '10' ;
  4493. B . 'COF' . iop . 'COMPOR' = nomloi ;
  4494. B . 'COF' . iop . 'LDAT' = 'LECT' 1 ;
  4495. B . iop . 1 . 0 = 'LECT' iop ;
  4496. 'FINSI' ;
  4497. *
  4498. res = 'NLIN' gdisc _mt A B 'EREF' methgau ;
  4499. *
  4500. 'RESPRO' res ;
  4501. *
  4502. * End of procedure file TSURRESI
  4503. *
  4504. 'FINPROC' ;
  4505. *ENDPROCEDUR tsurresi
  4506. *BEGINPROCEDUR vide
  4507. ************************************************************************
  4508. * NOM : VIDE
  4509. * DESCRIPTION : Construit un objet vide
  4510. *
  4511. *
  4512. *
  4513. * LANGAGE : GIBIANE-CAST3M
  4514. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  4515. * mél : gounand@semt2.smts.cea.fr
  4516. **********************************************************************
  4517. * VERSION : v1, 14/09/2004, version initiale
  4518. * HISTORIQUE : v1, 14/09/2004, création
  4519. * HISTORIQUE :
  4520. * HISTORIQUE :
  4521. ************************************************************************
  4522. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  4523. * en cas de modification de ce sous-programme afin de faciliter
  4524. * la maintenance !
  4525. ************************************************************************
  4526. *
  4527. *
  4528. 'DEBPROC' VIDE ;
  4529. 'REPETER' bcl ;
  4530. 'ARGUMENT' typ/'MOT' ;
  4531. 'SI' ('NON' ('EXISTE' typ)) ;
  4532. 'QUITTER' bcl ;
  4533. 'FINSI' ;
  4534. vdim = 'VALEUR' 'DIME' ;
  4535. 'SI' ('EGA' vdim 1) ;
  4536. p1 = 'POIN' 0. ;
  4537. 'FINSI' ;
  4538. 'SI' ('EGA' vdim 2) ;
  4539. p1 = 'POIN' 0. 0. ;
  4540. 'FINSI' ;
  4541. 'SI' ('EGA' vdim 3) ;
  4542. p1 = 'POIN' 0. 0. 0.;
  4543. 'FINSI' ;
  4544. p2 = 'PLUS' p1 p1 ;
  4545. mp1 = 'MANUEL' 'POI1' p1 ;
  4546. mp2 = 'MANUEL' 'POI1' p2 ;
  4547. 'SI' ('EGA' typ 'MAIL') ;
  4548. mailvid = mp1 'ELEM' 'APPUYE' 'STRICTEMENT' mp2 'NOVERIF' ;
  4549. 'RESPRO' mailvid ;
  4550. 'FINSI' ;
  4551. 'SI' ('EGA' typ 'CHPO') ;
  4552. chp1 = 'MANUEL' 'CHPO' mp1 1 'T' 0.D0 'NATURE' 'DISCRET' ;
  4553. chpvid = 'EXCO' 'Q' chp1 'NOID' ;
  4554. 'RESPRO' chpvid ;
  4555. 'FINSI' ;
  4556. 'SI' ('EGA' typ 'RIGI') ;
  4557. rig1 = 'MANUEL' 'RIGIDITE' mp1 ('MOTS' 'T') ('PROG' 0.D0) ;
  4558. rigvid = 'EXTRAIRE' rig1 'RIGI' 'MULT' ;
  4559. 'RESPRO' rigvid ;
  4560. 'FINSI' ;
  4561. 'FIN' bcl ;
  4562. *
  4563. * End of procedure file VIDE
  4564. *
  4565. 'FINPROC' ;
  4566. *ENDPROCEDUR vide
  4567. **
  4568. ************************************************************************
  4569. *
  4570. *
  4571. * END OF PROCEDURES
  4572. *
  4573. *
  4574. ************************************************************************
  4575. ************************************************************************
  4576. *
  4577. *
  4578. * MAIN : 1) MESH
  4579. * 2) COMPUTATIONAL LOOP
  4580. * 3) TESTs
  4581. *
  4582. ************************************************************************
  4583. *
  4584. * Construction du "modèle" (maillage)
  4585. * et des paramètres de départ
  4586. *
  4587. 'SI' complet ;
  4588. raff = 3 ;
  4589. nitermax = 25 ;
  4590. critnf = 5.D-4 ;
  4591. critdf = 5.D-4 ;
  4592. 'SINON' ;
  4593. raff = 2 ;
  4594. nitermax = 15 ;
  4595. critnf = 5.D-3 ;
  4596. critdf = 5.D-3 ;
  4597. 'FINSI' ;
  4598. *
  4599. * si clbloq : on utilise les blocages pour les clim de Dirichlet
  4600. clbloq = vrai ;
  4601. *omegn = 0.5 ; nitn = 20 ; critn = 5.D-3 ;
  4602. *omegd = 0.5 ; nitd = 20 ; critd = 1.D-1 ; nbck = 16 ;
  4603. omegn = 0.75 ; nitn = 1 ; critn = 1.D-3 ;
  4604. omegd = 0.75 ; nitd = 20 ; critd = 1.D-3 ; nbck = 1 ;
  4605. tbfor = faux ;
  4606. tjaco = FAUX ;
  4607. lpdro = vrai ;
  4608. idir = 1 ; jacoxf = 3 ; jacoxg = 0 ; jacoxv = 0 ;
  4609. jacoxt = 'LECT' 1 2 3 4;
  4610. lrest = 'EGA' ('TYPE' tdisc) 'TABLE' ;
  4611. 'SI' ('NON' lrest) ;
  4612. discg = 'QUAF' ; discv = 'QUAF' ; discp = 'LINM' ;
  4613. *
  4614. vdim = 'VALEUR' 'DIME' ;
  4615. vmod = 'VALEUR' 'MODE' ;
  4616. *
  4617. * Numérique
  4618. *
  4619. *
  4620. rsou = 1. ; lav = 20. ; lap = 20. ; prof = 20. ;
  4621. diam = '*' rsou 2. ;
  4622. *
  4623. *
  4624. * Création du maillage
  4625. *
  4626. tdisc = DEFMAIL rsou lav lap prof raff ;
  4627. tdisc . 'methgau' = 'TABLE' ;
  4628. tdisc . 'methgau' . 'mass' = 'GAM2' ;
  4629. tdisc . 'methgau' . 'amor' = 'GAM2' ;
  4630. tdisc . 'methgau' . 'rigi' = 'GAR2' ;
  4631. *tdisc . 'methgau' . 'mass' = 'GAU7' ;
  4632. *tdisc . 'methgau' . 'amor' = 'GAU7' ;
  4633. *tdisc . 'methgau' . 'rigi' = 'GAU7' ;
  4634. *
  4635. DISCG = TDISC . 'GEOM' . 'DISC' ;
  4636. DISCU = TDISC . 'XN' . 'DISC' ;
  4637. DISCV = TDISC . 'UN' . 'DISC' ;
  4638. NOMDEP = @STBL (TDISC . 'XN' . 'NOMINC') ;
  4639. NOMVIT = @STBL (TDISC . 'UN' . 'NOMINC') ;
  4640. NOMPRE = @STBL (TDISC . 'PN' . 'NOMINC') ;
  4641. NOMFOR = @STBL (TDISC . 'FN' . 'NOMINC') ;
  4642. *
  4643. *
  4644. _mtw = tdisc . 'mtw' . 'QUAF' ;
  4645. _cmtw = tdisc . 'cmtw' . 'QUAF' ;
  4646. _hau = tdisc . 'hau' . 'QUAF' ;
  4647. _gau = tdisc . 'gau' . 'QUAF' ;
  4648. _bas = tdisc . 'bas' . 'QUAF' ;
  4649. _dro = tdisc . 'dro' . 'QUAF' ;
  4650. mtw = tdisc . 'mtw' . discg ;
  4651. cmtw = tdisc . 'cmtw' . discg ;
  4652. mdes = cmtw ;
  4653. hau = tdisc . 'hau' . discg ;
  4654. gau = tdisc . 'gau' . discg ;
  4655. bas = tdisc . 'bas' . discg ;
  4656. dro = tdisc . 'dro' . discg ;
  4657. 'SI' ('EGA' vdim 3) ;
  4658. _fro = tdisc . 'fro' .'QUAF' ;
  4659. fro = tdisc . 'fro' . discg ;
  4660. _rea = tdisc . 'rea' .'QUAF' ;
  4661. rea = tdisc . 'rea' . discg ;
  4662. _dhau = tdisc . 'dhau' .'QUAF' ;
  4663. dhau = tdisc . 'dhau' . discg ;
  4664. amtw = 'ARETE' mtw ;
  4665. mdes = amtw ;
  4666. 'FINSI' ;
  4667. *
  4668. *list vdim;
  4669. *list ('PROG' vdim * 0.);
  4670.  
  4671. * CB215821 : Ancienne syntaxe supprimee en 2015
  4672. *pA = 'POIN' hau 'PROC' ('POIN' ('PROG' vdim * 0.)) ;
  4673. *mpA = 'COULEUR' ('MANUEL' 'POI1' pA) 'ROUG' ;
  4674. * Maillage pour les blocages en vitesse
  4675. *'TRACER' 'CACH' mtw 'TITR' ('CHAINE' 'nbl=' ('NBEL' mtw))
  4676. * 'NCLK' ;
  4677. *
  4678. 'SI' ('EGA' vdim 2) ;
  4679. pA = 'POIN' hau 'PROC' ('POIN' 0. 0. ) ;
  4680. mpA = 'COULEUR' ('MANUEL' 'POI1' pA) 'ROUG' ;
  4681.  
  4682. mblux = gau ;
  4683. mblux = 'COULEUR' ('CHANGER' 'POI1' mblux) 'ROUG' ;
  4684. mblun = 'COULEUR' ('CHANGER' 'POI1' hau) 'ROUG' ;
  4685. * mbluy = gau 'ET' bas 'ET' dro ;
  4686. mbluy = gau 'ET' bas ;
  4687. mbluy = 'CHANGER' mbluy 'POI1' ;
  4688. mpoi = 'INTERSECTION' mblun mbluy ;
  4689. 'SI' ('NEG' ('NBEL' mpoi) 0) ;
  4690. mbluy = 'DIFF' mbluy mpoi ;
  4691. 'FINSI' ;
  4692. mbluy = 'COULEUR' mbluy 'ROUG' ;
  4693. *mblpn = 'POIN' (GMAIL _mtr 'PN') 'INITIAL' ;
  4694. 'FINSI' ;
  4695. 'SI' ('EGA' vdim 3) ;
  4696. pA = 'POIN' hau 'PROC' ('POIN' 0. 0. 0.) ;
  4697. mpA = 'COULEUR' ('MANUEL' 'POI1' pA) 'ROUG' ;
  4698.  
  4699. mblux = gau ;
  4700. mblux = 'COULEUR' ('CHANGER' 'POI1' mblux) 'ROUG' ;
  4701. mbluy = gau 'ET' fro 'ET' rea ;
  4702. mbluy = 'COULEUR' ('CHANGER' 'POI1' mbluy) 'ROUG' ;
  4703. mblun = 'COULEUR' ('CHANGER' 'POI1' hau) 'ROUG' ;
  4704. mbluz = gau 'ET' bas ;
  4705. mbluz = 'CHANGER' mbluz 'POI1' ;
  4706. mpoi = 'INTERSECTION' mblun mbluz ;
  4707. 'SI' ('NEG' ('NBEL' mpoi) 0) ;
  4708. mbluz = 'DIFF' mbluz mpoi ;
  4709. 'FINSI' ;
  4710. mbluz = 'COULEUR' mbluz 'ROUG' ;
  4711. *mblpn = 'POIN' (GMAIL _mtr 'PN') 'INITIAL' ;
  4712. 'FINSI' ;
  4713.  
  4714. 'SI' faux ;
  4715. mdd =mtw ;
  4716. 'SI' ('EGA' vdim 3); mdd = cmtw ; 'FINSI' ;
  4717. 'TRACER' ('ET' mdd mpA) 'TITR' 'Point dobservation pA' ;
  4718. 'TRACER' ('ET' mdd mblux) 'TITR' 'Blocage UX' ;
  4719. 'TRACER' ('ET' mdd mbluy) 'TITR' 'Blocage UY' ;
  4720. 'TRACER' ('ET' mdd mblun) 'TITR' 'Blocage UN' ;
  4721. 'FINSI' ;
  4722. * 'OPTI' 'MODE' plan ;
  4723. met = calimet _mtw discg 'GAU1' ;
  4724. ************************************************************************
  4725. *
  4726. * COMPUTATIONAL LOOP
  4727. *
  4728. ************************************************************************
  4729. * Re : nombre de Reynolds (convection / viscosité)
  4730. * Eu : nombre d'Euler (pression imposée / convection)
  4731. * FrEu : nombre de Froude * nombre d'Euler (pression imposée / gravité)
  4732. * We : (pression imposée / tension de surface)
  4733. *
  4734. 'DEBPROC' calcul ;
  4735. 'ARGUMENT' Re*'FLOTTANT' ;
  4736. 'ARGUMENT' Eu*'FLOTTANT' ;
  4737. 'ARGUMENT' FrEu*'FLOTTANT' ;
  4738. 'ARGUMENT' We*'FLOTTANT' ;
  4739. *
  4740. ckonv = '/' 1. Eu ;
  4741. crig = '/' 1. ('*' Re Eu) ;
  4742. cgra = '/' 1. FrEu ;
  4743. ctsur = '/' 1. We. ;
  4744. *
  4745. nomdir = 'CHAINE' '/test4/gounand/kong/' ;
  4746. nomfic = 'CHAINE' 'defila' vdim 'd'
  4747. 'Re' (MYENT Re)
  4748. 'Eu' (MYENT Eu)
  4749. 'FE' (MYENT FrEu)
  4750. 'We' (MYENT We)
  4751. 'r' raff ;
  4752. *
  4753. * Boucle d'itérations
  4754. *
  4755. vol = GVOL _cmtw tdisc faux ;
  4756. 'SI' debug ;
  4757. 'MESSAGE' ('CHAINE' 'Volume initial = ' (formar vol 2)) ;
  4758. 'FINSI' ;
  4759. pini = 0. ;
  4760. delp = 0. ; delp2 = 0. ;
  4761. lza = 'PROG' ;
  4762. *
  4763. *sol = vide 'CHPO' ;
  4764. mailv = GMAIL _mtw (tdisc . 'UN' . 'DISC') ;
  4765. NOMVIT = @STBL (TDISC . 'UN' . 'NOMINC') ;
  4766. sol = 'MANU' 'CHPO' mailv nomvit ('PROG' 0. 0.) ;
  4767. itcou = 0 ;
  4768. *tc smise en commentaire deu finsi cidessous
  4769. *'FINSI';
  4770. *DEFSUMM ;
  4771. 'REPETER' it nitermax ;
  4772. * 'MESSAGE' ('CHAINE' 'itcou = ' ('+' itcou 1)) ;
  4773. 'SI' lpdro ; delp = '+' delp delp2 ; 'FINSI' ;
  4774. *
  4775. * Problème volumique
  4776. *
  4777. 'REPETER' itn nitn ;
  4778. sol = 'EXCO' (nomvit 'ET' nompre) sol 'NOID' ;
  4779. * 'MESSAGE' ('CHAINE' 'itn = ' &itn) ;
  4780. *
  4781. * Terme de pression
  4782. *
  4783. 'SI' ('EGA' vdim 2) ;
  4784. rhau = 'COORDONNEE' 1 hau ;
  4785. 'SINON' ;
  4786. * rhau = 'COORDONNEE' 1 hau ;
  4787. xhau = 'COORDONNEE' 1 hau ;
  4788. yhau = 'COORDONNEE' 2 hau ;
  4789. rhau = '**' ('+' ('**' xhau 2) ('**' yhau 2)) 0.5 ;
  4790. 'FINSI' ;
  4791. pfor = 'EXP' ('*' ('**' ('/' rhau rsou) 2) -1.) ;
  4792. fpfor = GFORC _hau tdisc pfor ;
  4793. ktforx = GKFORC _hau tdisc pfor jacoxf ;
  4794. * ktforx0 = GKFORC _hau tdisc pfor 0 ;
  4795. 'SI' ('EGA' jacoxf 3) ;
  4796. ktforx = '*' ktforx 0. ;
  4797. 'FINSI' ;
  4798. * TRVEC hau fpfor 'FPFOR' ;
  4799. *
  4800. * Terme de gravité
  4801. *
  4802. fpgra = GGRAVI _hau tdisc cgra 0. ;
  4803. ktgrax = GKGRAVI _hau tdisc jacoxg ('*' cgra -1.) 0. ;
  4804. * ktgrax0 = GKGRAVI _hau tdisc 0 ('*' cgra -1.) 0. ;
  4805. *
  4806. * Tension de surface
  4807. *
  4808. mgtens = tdisc . 'methgau' . 'rigi' ;
  4809. ftsur = TSURRESI _hau discg mgtens nomvit ('*' -1. ctsur) ;
  4810. 'SI' tbfor ;
  4811. ftsura = 'REDU' ftsur ('POIN' hau 'INITIAL') ;
  4812. ftsur = '-' ftsur ftsura ;
  4813. 'FINSI' ;
  4814. ktsurx = TSURKTAN _hau discg mgtens nomvit nomvit ('*' -1. ctsur)
  4815. jacoxt ;
  4816. * ktsurx0 = TSURKTAN _hau discg mgtens nomvit nomvit
  4817. * ('*' -1. ctsur) ('LECT' 1 2 3 4) ;
  4818. *
  4819. * Terme de pression sur le bord droit
  4820. *
  4821. * 'MESSAGE' ('CHAINE' 'delp=' delp) ;
  4822. * 'MESSAGE' ('CHAINE' 'delp2=' delp2) ;
  4823. 'SI' lpdro ;
  4824. lpn = 'PROG' vdim * 0. ;
  4825. 'REMPLACER' lpn 1 ('*' delp -1.) ;
  4826. ftpdr = GMASS2 _dro tdisc 'NPRI' 'UN'
  4827. 'FPRI' lpn
  4828. 'NDUA' 'UN' ;
  4829. 'FINSI' ;
  4830. *
  4831. * Rigidité
  4832. *
  4833. gri = GRIG _mtw tdisc 'NPRI' 'UN' 'NDUA' 'UN' ;
  4834. gri = '*' gri crig ;
  4835. * Autres matrices
  4836. gugr = gugrad2 _mtw tdisc 'NPRI' 'UN' 'NDUA' 'UN'
  4837. 'NVIT' 'UN' 'CVIT' sol ;
  4838. gugr = '*' gugr ckonv ;
  4839. gdiv = GDIV2 _mtw tdisc 'NPRI' 'UN' 'NDUA' 'PN' 'GBBT' ;
  4840. gdiv = '*' gdiv -1. ;
  4841. * Blocages
  4842. cblox = '+' ('MANUEL' 'CHPO' mblux 1 'UX' 0.)
  4843. ('MANUEL' 'CHPO' gau 1 'UX' 1.) ;
  4844. 'SI' clbloq ;
  4845. mblox = 'BLOQUE' 'UX' mblux ;
  4846. fblox = 'DEPIMPOSE' mblox cblox ;
  4847. fblox = 'NOMC' 'LX' fblox ;
  4848. 'FINSI' ;
  4849. *
  4850. cbloy = 'MANUEL' 'CHPO' mbluy 1 'UY' 0. ;
  4851. 'SI' clbloq ;
  4852. mbloy = 'BLOQUE' 'UY' mbluy ;
  4853. 'FINSI' ;
  4854. vnor = DEFDD tdisc 0 ;
  4855. mblon = 'BLOQUE' 'DEPL' 'DIRE' vnor mblun ;
  4856. mp = GMAIL _mtw 'PN' ;
  4857. * mblop = 'BLOQUE' 'T' ('POIN' mp 'INITIAL') ;
  4858. 'SI' clbloq ;
  4859. mblot = mblox 'ET' mbloy 'ET' mblon ;
  4860. 'SINON' ;
  4861. cblot = cblox '+' cbloy ;
  4862. mblot = mblon ;
  4863. 'FINSI' ;
  4864. 'SI' ('EGA' vdim 3) ;
  4865. cbloz = 'MANUEL' 'CHPO' mbluz 1 'UZ' 0. ;
  4866. mbloz = 'BLOQUE' 'UZ' mbluz ;
  4867. 'SI' clbloq ;
  4868. mblot = mblot 'ET' mbloz ;
  4869. 'SINON' ;
  4870. mblot = mblon ;
  4871. cblot = cblot '+' cbloz ;
  4872. 'FINSI' ;
  4873. 'FINSI' ;
  4874. * Changement type et noms d'inconnues
  4875. mpri = nomdep 'ET' ('MOTS' 'T' 'LX') ;
  4876. mdua = nomfor 'ET' ('MOTS' 'Q' 'FLX') ;
  4877. mfin = nomdep 'ET' ('MOTS' 'LX1' 'LX') ;
  4878. 'SI' clbloq ;
  4879. 'SI' lmatrik ;
  4880. mbloxk = 'CHANGER' 'INCO' ('KOPS' 'RIMA' mblox)
  4881. mpri mfin mdua mfin ;
  4882. mbloyk = 'CHANGER' 'INCO' ('KOPS' 'RIMA' mbloy)
  4883. mpri mfin mdua mfin ;
  4884. 'SI' ('EGA' vdim 3) ;
  4885. mblozk = 'CHANGER' 'INCO' ('KOPS' 'RIMA' mbloz)
  4886. mpri mfin mdua mfin ;
  4887. 'FINSI' ;
  4888. 'SINON' ;
  4889. mbloxk = 'CHANGER' 'INCO' mblox
  4890. mpri mfin mdua mfin 'MULT' ;
  4891. mbloyk = 'CHANGER' 'INCO' mbloy
  4892. mpri mfin mdua mfin 'MULT' ;
  4893. 'SI' ('EGA' vdim 3) ;
  4894. mblozk = 'CHANGER' 'INCO' mbloz
  4895. mpri mfin mdua mfin 'MULT' ;
  4896. 'FINSI' ;
  4897. 'FINSI' ;
  4898. 'FINSI' ;
  4899. 'SI' lmatrik ;
  4900. mblonk = 'CHANGER' 'INCO' ('KOPS' 'RIMA' mblon)
  4901. mpri mfin mdua mfin ;
  4902. mblotk = 'CHANGER' 'INCO' ('KOPS' 'RIMA' mblot)
  4903. mpri mfin mdua mfin ;
  4904. gugrk = 'KOPS' 'RIMA' gugr ;
  4905. grik = 'KOPS' 'RIMA' gri ;
  4906. gdivk = 'KOPS' 'RIMA' gdiv ;
  4907. 'SINON' ;
  4908. mblonk = 'CHANGER' 'INCO' mblon
  4909. mpri mfin mdua mfin 'MULT' ;
  4910. mblotk = 'CHANGER' 'INCO' mblot
  4911. mpri mfin mdua mfin 'MULT' ;
  4912. gugrk = gugr ;
  4913. grik = gri ;
  4914. gdivk = gdiv ;
  4915. 'FINSI' ;
  4916.  
  4917. ktot = gugrk 'ET' grik 'ET' gdivk 'ET' mblotk ;
  4918. ktg = ('*' (gugrk 'ET' grik) ('/' 1. omegn)) 'ET' gdivk
  4919. 'ET' mblotk ;
  4920. 'SI' ('EGA' vdim 3) ;
  4921. mpvid = GMASS2 _mtw tdisc 'NPRI' 'PN' 'NDUA' 'PN'
  4922. 'NCOF' 'CSTE' 'FCOF' 0. ;
  4923. 'SI' lmatrik ;
  4924. mpvidk = 'KOPS' 'RIMA' mpvid ;
  4925. 'SINON' ;
  4926. mpvidk = mpvid ;
  4927. 'FINSI' ;
  4928. ktg = ktg 'ET' mpvidk ;
  4929. 'FINSI' ;
  4930. ftot = vide 'CHPO' ;
  4931. 'SI' clbloq ;
  4932. ftot = ftot '+' fblox ;
  4933. 'FINSI' ;
  4934. 'SI' tbfor ;
  4935. ftot = ftot '+' fpgra '+' ftsur '+' fpfor ;
  4936. 'FINSI' ;
  4937. 'SI' lpdro ;
  4938. ftot = '+' ftot ftpdr ;
  4939. 'FINSI' ;
  4940. 'SI' ('NON' clbloq) ;
  4941. sol = SURCHPO sol cblot ;
  4942. 'FINSI' ;
  4943. ftot = '-' ftot ('*' ktot sol) ;
  4944. * 'SI' tbfor ;
  4945. * Conditions de sortie libre (pas de force tangentielle)
  4946. * sur le dernier point de _hau
  4947. * phauf = 'POIN' hau 'FINAL' ;
  4948. * ftan = 'REDU' ftot phauf ;
  4949. * ftanr = 'EXCO' 'UR' ftan 'UR' ;
  4950. * ftanr = '*' ftanr -1. ;
  4951. * ftot = '+' ftot ftanr ;
  4952. * 'FINSI' ;
  4953. *
  4954. * cp = 'MANUEL' 'CHPO' ('POIN' mp 'INITIAL')
  4955. * 1 ('EXTRAIRE' nompre 1) delp2 ;
  4956. * ccl = cp ;
  4957. * dsol = 'KRES' ktg ftot 'CLIM' ccl ;
  4958. 'SI' ('EGA' ('TYPE' ktg) 'RIGIDITE') ;
  4959. ktgr = 'KOPS' 'NINCPRDU' ktg ;
  4960. ftotr = 'KOPS' 'NINCPRDU' ftot ;
  4961. 'SINON' ;
  4962. ktgr = ktg ;
  4963. ftotr = ftot ;
  4964. 'FINSI' ;
  4965. 'SI' clbloq ;
  4966. dsol = 'KRES' ktgr ftotr ;
  4967. 'SINON' ;
  4968. dsol tt = 'KRES' ktgr ftotr 'CLIM' ('-' cblot cblot)
  4969. 'IMPR' 0 'RESID' 1.D-10 'PRECOND' 5
  4970. 'ILUTLFIL' 2. 'ILUTPPIV' 0.
  4971. 'TYPINV' 3 'LBCG' 2 'LTIME' VRAI ;
  4972. * 'LISTE' tt ;
  4973. 'FINSI' ;
  4974. sol = '+' sol dsol ;
  4975. vit = 'EXCO' nomdep 'NOID' sol ;
  4976. pre = 'EXCO' nompre sol ;
  4977. mdv = 'MAXIMUM' dsol 'ABS' 'AVEC' nomvit ;
  4978. mdvr = '/' mdv ('MAXIMUM' vit 'ABS') ;
  4979. 'SI' debug ;
  4980. 'MESSAGE' ('CHAINE' ' ' 'itn=' &itn
  4981. ' mdv=' (formar mdv 2) ' mdvr=' (formar mdvr 2)) ;
  4982. 'FINSI' ;
  4983. *
  4984. * JETPROF1 ('*' rsou 20.) VRAI ;
  4985. 'SI' ('EGA' vdim 2) ; rvit = vit ;
  4986. 'SINON' ; rvit = 'REDU' vit cmtw ; 'FINSI' ;
  4987. 'SI' (graph 'ET' interact) ;
  4988. TRVEC mdes rvit 'Vit' vrai ;
  4989. 'FINSI' ;
  4990. ** On enlève les multiplicateurs de Lagrange.
  4991. 'SI' ('<' mdvr critn) ;
  4992. 'QUITTER' itn ;
  4993. 'FINSI' ;
  4994. 'FIN' itn ;
  4995. *
  4996. * Post-traitement après calcul de la vitesse
  4997. *
  4998. 'SI' graph ;
  4999. 'SI' dbggra1 ; DEFVIT ; 'FINSI' ;
  5000. 'SI' dbggra2 ; DEFVSURF ; defvsurf ('*' rsou 5.) ;
  5001. * 'SINON' ; defvsurf ('*' rsou 5.) vrai ; attente 1. ;
  5002. 'FINSI' ;
  5003. 'FINSI' ;
  5004. *
  5005. * Forces
  5006. *
  5007. fpre = 'EXCO' nomdep 'NOID' ('*' ('*' gdivk -1.) sol) ;
  5008. fblon = 'EXCO' nomdep 'NOID' ('*' ('*' mblonk -1.) sol) 'NOID' ;
  5009. 'SI' clbloq ;
  5010. fblox = 'EXCO' nomdep 'NOID' ('*' ('*' mbloxk -1.) sol) 'NOID' ;
  5011. fbloy = 'EXCO' nomdep 'NOID' ('*' ('*' mbloyk -1.) sol) 'NOID' ;
  5012. 'SI' ('EGA' vdim 3) ;
  5013. fbloz = 'EXCO' nomdep 'NOID' ('*' ('*' mblozk -1.) sol) 'NOID' ;
  5014. 'FINSI' ;
  5015. 'FINSI' ;
  5016. frig = ('*' ('*' grik -1.) sol) ;
  5017. fugr = 'EXCO' nomdep 'NOID' ('*' ('*' gugr -1.) sol) ;
  5018. desfq = fpre '+' frig '+' fugr '+' fblon ;
  5019. 'SI' clbloq ;
  5020. desfq = desfq '+' fblox '+' fbloy ;
  5021. 'SI' ('EGA' vdim 3) ;
  5022. desfq = '+' desfq fbloz ;
  5023. 'FINSI' ;
  5024. 'FINSI' ;
  5025. 'SI' tbfor ;
  5026. desfq = desfq '+' fpgra '+' ftsur '+' fpfor ;
  5027. 'FINSI' ;
  5028. 'SI' graph ;
  5029. 'SI' ('ET' clbloq ('EGA' vdim 2)) ;
  5030. 'SI' dbggra1 ; DEFQFORV ; 'FINSI' ;
  5031. 'SI' dbggra1 ; DEFQFORS ('*' rsou 5.) ;
  5032. * 'SINON' ; DEFQFORS ('*' rsou 5.) vrai ;
  5033. 'FINSI' ;
  5034. 'FINSI' ;
  5035. 'FINSI' ;
  5036. *
  5037. * On a calculé les forces et le déséquilibre normal, on en déduit le
  5038. * déplacement normal
  5039. *
  5040. 'SI' tbfor ;
  5041. desn = ('*' fblon -1.) ;
  5042. 'SINON' ;
  5043. desn = ('*' fblon -1.) '+' fpgra '+' ftsur '+' fpfor ;
  5044. 'FINSI' ;
  5045. ktotx = ktgrax 'ET' ktforx 'ET' ktsurx ;
  5046. ktotx = '*' ktotx -1. ;
  5047. *
  5048. * Contrainte sur le volume
  5049. *
  5050. volc = GVOL _cmtw tdisc ;
  5051. dvol = ('-' vol volc) '*' -1. ;
  5052. kvol = GKVOL _cmtw tdisc jacoxv ;
  5053. *
  5054. * Réduction du système sur l'inconnue déplacement normal
  5055. *
  5056. vnorn = DEFDD tdisc idir ;
  5057. vnor = vnorn ;
  5058. ok = FAUX ;
  5059. omd = omegd ;
  5060. 'REPETER' bck nbck ;
  5061. ktot ftot = PROJSYSC tdisc vnor ('*' ktotx ('/' 1. omd))
  5062. desn kvol dvol ;
  5063. 'SI' ('EGA' ('TYPE' ktot) 'RIGIDITE') ;
  5064. ktotr = 'KOPS' 'NINCPRDU' ktot ;
  5065. ftotr = 'KOPS' 'NINCPRDU' ftot ;
  5066. 'SINON' ;
  5067. ktotr = ktot ;
  5068. ftotr = ftot ;
  5069. 'FINSI' ;
  5070. sold = 'KRES' ktotr ftotr ;
  5071. dep = '*' ('EXCO' 'SCAL' sold) vnor ;
  5072. mdep = 'MAXIMUM' dep 'ABS' ;
  5073. mdepr = '/' mdep prof ;
  5074. odep = dep ;
  5075. *
  5076. * Bilan des forces
  5077. *
  5078. fblonn = 'PSCAL' ('*' fblon -1.) vnor nomdep nomdep ;
  5079. 'SI' ('NON' tbfor) ;
  5080. ffornn = 'PSCAL' fpfor vnor nomdep nomdep ;
  5081. fgrann = 'PSCAL' fpgra vnor nomdep nomdep ;
  5082. fsurnn = 'PSCAL' ftsur vnor nomdep nomdep ;
  5083. 'FINSI' ;
  5084. mulag = 'EXCO' 'LX' sold 'LX' ;
  5085. delp2 = 'MAXIMUM' mulag ;
  5086. fpvolnn = '*' ktot ('*' mulag -1.) ;
  5087. * Bilan des forces en surface
  5088. 'SI' tbfor ;
  5089. desfd = fblonn '+' fpvolnn ;
  5090. 'SINON' ;
  5091. desfd = fblonn '+' fgrann '+' fsurnn '+' ffornn '+' fpvolnn ;
  5092. 'FINSI' ;
  5093. *
  5094. 'SI' debug ;
  5095. chmes = 'CHAINE' ' dvol=' (formar dvol 1) ;
  5096. chmes2 = 'CHAINE' ' mdep=' (formar mdep 1)
  5097. ' mdepr=' (formar mdepr 1)
  5098. ' delp2=' (formar delp2 1) ;
  5099. 'SI' ('>' &bck 1) ;
  5100. chmes = 'CHAINE' '! bck=' &bck ' ' chmes ;
  5101. 'FINSI' ;
  5102. 'MESSAGE' chmes ; 'MESSAGE' chmes2 ;
  5103. 'FINSI' ;
  5104. 'SI' graph ;
  5105. 'SI' ('EGA' vdim 2) ;
  5106. 'SI' dbggra2 ; DEFDFORS ;
  5107. * 'SINON' ; DEFDFORS ('*' 5. rsou) vrai ;
  5108. 'FINSI' ;
  5109. 'FINSI' ;
  5110. 'FINSI' ;
  5111. 'SI' ('<' mdep critd) ;
  5112. 'QUITTER' bck ;
  5113. 'SINON' ;
  5114. omd = '/' omd 2. ;
  5115. 'FINSI' ;
  5116. 'FIN' bck ;
  5117. 'SI' ('ET' ('<' mdepr critdf) ('<' mdvr critnf)) ;
  5118. itcou = '+' itcou 1 ;
  5119. 'QUITTER' it ;
  5120. 'FINSI' ;
  5121. *
  5122. * Déplacement du maillage
  5123. *
  5124. 'SI' ('EGA' vdim 2) ;
  5125. muy = bas 'ET' hau ;
  5126. bux = 'BLOQUE' 'UX' mtw ;
  5127. buy = 'BLOQUE' 'UY' muy ;
  5128. cblo = ('MANUEL' 'CHPO' cmtw 2 'UX' 0. 'UY' 0.) '+'
  5129. odep ;
  5130. ftot = 'DEPIMPOSE' buy cblo ;
  5131. dxv = 'DEDU' adap mtw (bux 'ET' buy) ftot 'METR' met 'CSTE'
  5132. 'NITM' 1 ;
  5133. 'SINON' ;
  5134. muz = bas 'ET' hau ;
  5135. bux = 'BLOQUE' 'UX' mtw ;
  5136. buy = 'BLOQUE' 'UY' mtw ;
  5137. buz = 'BLOQUE' 'UZ' muz ;
  5138. btot = bux 'ET' buy 'ET' buz ;
  5139. cblo = ('MANUEL' 'CHPO' muz 1 'UZ' 0.) '+'
  5140. odep ;
  5141. ftot = 'DEPIMPOSE' buz cblo ;
  5142. dxv = 'DEDU' adap mtw btot ftot 'METR' met 'CSTE'
  5143. 'NITM' 1 ;
  5144. 'FINSI' ;
  5145. 'FORME' dxv ;
  5146. *
  5147. * Tracé du profil
  5148. *
  5149. za = 'COORDONNEE' vdim pA ;
  5150. zcmt = 'COORDONNEE' vdim hau ;
  5151. miz = 'MINIMUM' zcmt ; maz = 'MAXIMUM' zcmt ;
  5152. miv = 'MINIMUM' vit ; mav = 'MAXIMUM' vit ;
  5153. 'MESSAGE' ('CHAINE' 'It=' ('+' itcou 1)
  5154. ' zA=' (formar zA 2) ' miz=' (formar miz 2)
  5155. ' maz=' (formar maz 2) ' miv=' (formar miv 2)
  5156. ' mav=' (formar mav 2) ) ;
  5157. lza = 'ET' lza ('PROG' zA) ;
  5158. 'SI' graph ;
  5159. 'SI' dbggra2 ; DEFZSURF ; defzsurf ('*' rsou 5.) ;
  5160. 'SINON' ; defzsurf ('*' rsou 5.) vrai ; 'FINSI' ;
  5161. 'FINSI' ;
  5162. itcou = '+' itcou 1 ;
  5163. 'FIN' it ;
  5164. *
  5165. 'SI' graph ;
  5166. dza = 'DIME' lza ;
  5167. 'SI' (> dza 1) ;
  5168. lit = 'PROG' 1. 'PAS' 1 dza ;
  5169. tabev = 'TABLE' ; tabt = 'TABLE' ;
  5170. tabev . 1 = 'EVOL' 'MANU' lit lza ;
  5171. tabt . 1 = 'CHAINE' 'Z pA' ;
  5172. tix = 'iter' ; tiy = 'z' ; tit = 'CHAINE' tiy '(' tix ')' ;
  5173. dessevol (@STBL tabev) tabt tit tix tiy ;
  5174. 'FINSI' ;
  5175. 'FINSI' ;
  5176. * list *MATRIK ;
  5177. 'OUBL' KTG ; 'OUBL' KTOT ; 'OUBL' GDIVK ; 'OUBL' GRIK ;
  5178. 'OUBL' GUGRK ; 'OUBL' MBLOTK ; 'OUBL' MBLONK ; 'OUBL' MBLOZK ;
  5179. 'OUBLIER' MBLORK ; 'OUBLIER' mbloyk ; 'OUBLIER' mbloxk ;
  5180. 'OUBLIER' mpvidk ;
  5181. * list *rigidite ;
  5182. 'OUBLIER' btot ;'OUBLIER' buz ; 'OUBLIER' mbloy ; 'OUBLIER' mblox ;
  5183. 'OUBL' BUY ; 'OUBL' BUX ; 'OUBL' KTOTX ; 'OUBL' KTPREX0 ;
  5184. 'OUBL' KTPREX ; 'OUBL' KTDIVX2 ; 'OUBL' KTDIVX1 ; 'OUBL' KTUGRX0 ;
  5185. 'OUBL' KTUGRX ; 'OUBL' KTUGRX2 ; 'OUBL' KTUGRX1 ; 'OUBL' KTRIGX0 ;
  5186. 'OUBL' KTRIGX ; 'OUBL' KTRIGX2 ; 'OUBL' KTRIGX1 ; 'OUBL' GMABS ;
  5187. 'OUBL' GMAB ; 'OUBL' GMAV ; 'OUBL' MBLOT ; 'OUBL' MBLON ;
  5188. 'OUBL' MBLOZ ; 'OUBL' MBLOR ; 'OUBL' GUGR ; 'OUBL' GRI ;
  5189. 'OUBL' KTSURX0 ; 'OUBL' KTSURX ; 'OUBL' KTGRAX0 ; 'OUBL' KTGRAX ;
  5190. 'OUBLIER' ktforx0 ; 'OUBLIER' ktforx ;
  5191. 'OUBL' GDIV ; 'OUBLIER' mpvid ;
  5192. *fic = 'CHAINE' nomdir nomfic 'it' itcou '.sauv' ;
  5193. *'MESSAGE' ('CHAINE' 'Saving ' fic '...') ;
  5194. *'OPTI' 'SAUV' fic ;
  5195. *'SAUV' ;
  5196. *'TEMPS' 'IMPR' ;
  5197. 'SI' graph ;
  5198. *DEFSUMM ;
  5199. DEFVIT ;
  5200. *'SI' ('EGA' vdim 2) ;
  5201. *DEFQFORV ;
  5202. *DEFQFORS ;
  5203. *DEFQFORS ('*' rsou 5.) ;
  5204. *DEFDFORS ;
  5205. *DEFDFORS ('*' rsou 5.) ;
  5206. *'SINON' ;
  5207. * TRVEC mdes ('REDU' vit cmtw) 'Vit' ;
  5208. *'FINSI' ;
  5209. DEFZSURF ;
  5210. *defzsurf ('*' rsou 5.) ;
  5211. *DEFVSURF ;
  5212. *defvsurf ('*' rsou 5.) ;
  5213. *'TRACER' ('ET' mtw cmtw) 'TITR' ('CHAINE' 'nbl=' ('NBEL' mtw)) ;
  5214. 'FINSI' ;
  5215. 'RESPRO' zA miz maz ;
  5216. 'FINPROC' ;
  5217. ************************************************************************
  5218. *
  5219. * END OF COMPUTATIONAL LOOP
  5220. *
  5221. ************************************************************************
  5222. *
  5223. ************************************************************************
  5224. *
  5225. * TEST PART
  5226. *
  5227. ************************************************************************
  5228. *
  5229. lpass = VRAI ;
  5230. 'SAUTER' 2 'LIGNE' ; 'OPTI' 'ECHO' 1 ;
  5231. ***
  5232. *** Test 1 Re=50. Eu=10000. FrEu=1. We=10000.
  5233. ***
  5234. *** La pression imposée est équilibrée par le poids
  5235. *** de fluide déplacé. L'écoulement n'a pas
  5236. *** d'influence sur la forme de la surface.
  5237. ***
  5238. ***
  5239. 'OPTI' 'ECHO' 0 ;
  5240. Re = 50. ;
  5241. Eu= 10000. ;
  5242. FrEu = 1. ;
  5243. We = 10000. ;
  5244. lmatrik = faux ;
  5245. za miz maz = calcul Re Eu FrEu We ;
  5246. dz = '-' maz miz ;
  5247. * Reference values
  5248. zaref = -0.956 ; dzref = 1. ;
  5249. * Tests
  5250. AFFVAR zaref 'zaref' za 'za' ;
  5251. AFFVAR dzref 'dzref' dz 'dz' ;
  5252. errv = 2.D-2 ;
  5253. err1 = errrel za zaref ; tst1 = '<' err1 errv ;
  5254. err2 = errrel dz dzref ; tst2 = '<' err2 errv ;
  5255. tst = tst1 'ET' tst2 ;
  5256. 'MESSAGE' ('CHAINE' 'Test 1 :') ;
  5257. 'MESSAGE' ('CHAINE' ' err1 = ' err1) ;
  5258. 'MESSAGE' ('CHAINE' ' err2 = ' err2) ;
  5259. 'SI' tst ;
  5260. 'MESSAGE' 'Test 1 OK' ;
  5261. 'SINON' ;
  5262. 'MESSAGE' '!!! Test 1 not passed ' ;
  5263. 'FINSI' ;
  5264. lpass = lpass 'ET' tst ;
  5265. 'SAUTER' 2 'LIGNE' ; 'OPTI' 'ECHO' 1 ;
  5266. ***
  5267. *** Test 2 Re=50. Eu=10000. FrEu=1. We=1.
  5268. ***
  5269. *** La pression imposée est équilibrée par le poids
  5270. *** de fluide déplacé et la tension de surface.
  5271. *** L'écoulement n'a pas d'influence sur la forme de la surface.
  5272. *** On met lmatrik=vrai pour vérifier que l'algo marche
  5273. *** encore en MATRIK (les résultats doivent être strictement
  5274. *** identiques !)
  5275. ***
  5276. 'OPTI' 'ECHO' 0 ;
  5277. Re = 50. ;
  5278. Eu= 10000. ;
  5279. FrEu = 1. ;
  5280. We = 1. ;
  5281. lmatrik = vrai ;
  5282. za miz maz = calcul Re Eu FrEu We ;
  5283. dz = '-' maz miz ;
  5284. * Reference values
  5285. zaref = -0.505 ; dzref = 0.55 ;
  5286. * Tests
  5287. AFFVAR zaref 'zaref' za 'za' ;
  5288. AFFVAR dzref 'dzref' dz 'dz' ;
  5289. errv = 2.D-2 ;
  5290. err1 = errrel za zaref ; tst1 = '<' err1 errv ;
  5291. err2 = errrel dz dzref ; tst2 = '<' err2 errv ;
  5292. tst = tst1 'ET' tst2 ;
  5293. 'MESSAGE' ('CHAINE' 'Test 2 :') ;
  5294. 'MESSAGE' ('CHAINE' ' err1 = ' err1) ;
  5295. 'MESSAGE' ('CHAINE' ' err2 = ' err2) ;
  5296. 'SI' tst ;
  5297. 'MESSAGE' 'Test 2 OK' ;
  5298. 'SINON' ;
  5299. 'MESSAGE' '!!! Test 2 not passed ' ;
  5300. 'FINSI' ;
  5301. lpass = lpass 'ET' tst ;
  5302. 'SAUTER' 2 'LIGNE' ; 'OPTI' 'ECHO' 1 ;
  5303. ***
  5304. *** Test 3 Re=50. Eu=1. FrEu=1. We=1.
  5305. ***
  5306. *** La pression imposée est équilibrée par le poids
  5307. *** de fluide déplacé et la tension de surface.
  5308. *** L'écoulement influence la forme de la surface (aspiration).
  5309. ***
  5310. ***
  5311. 'OPTI' 'ECHO' 0 ;
  5312. Re = 50. ;
  5313. Eu= 1. ;
  5314. FrEu = 1. ;
  5315. We = 1. ;
  5316. lmatrik = faux ;
  5317. za miz maz = calcul Re Eu FrEu We ;
  5318. dz = '-' maz miz ;
  5319. * Reference values
  5320. zaref = -1.07 ; dzref = 1.21 ;
  5321. * Tests
  5322. AFFVAR zaref 'zaref' za 'za' ;
  5323. AFFVAR dzref 'dzref' dz 'dz' ;
  5324. errv = 2.D-2 ;
  5325. err1 = errrel za zaref ; tst1 = '<' err1 errv ;
  5326. err2 = errrel dz dzref ; tst2 = '<' err2 errv ;
  5327. tst = tst1 'ET' tst2 ;
  5328. 'MESSAGE' ('CHAINE' 'Test 3 :') ;
  5329. 'MESSAGE' ('CHAINE' ' err1 = ' err1) ;
  5330. 'MESSAGE' ('CHAINE' ' err2 = ' err2) ;
  5331. 'SI' tst ;
  5332. 'MESSAGE' 'Test 3 OK' ;
  5333. 'SINON' ;
  5334. 'MESSAGE' '!!! Test 3 not passed ' ;
  5335. 'FINSI' ;
  5336. lpass = lpass 'ET' tst ;
  5337.  
  5338.  
  5339.  
  5340. 'SAUTER' 2 'LIGNE' ;
  5341. 'SI' lpass ;
  5342. 'MESSAGE' 'Tout sest bien passe' ;
  5343. 'SINON' ;
  5344. 'MESSAGE' 'Il y a eu des erreurs' ;
  5345. 'FINSI' ;
  5346. 'SAUTER' 2 'LIGNE' ;
  5347. 'SI' ('NON' lpass) ;
  5348. 'ERREUR' 5 ;
  5349. 'FINSI' ;
  5350. ************************************************************************
  5351. *
  5352. * END OF TEST PART
  5353. *
  5354. ************************************************************************
  5355. 'SI' interact ;
  5356. 'OPTION' 'DONN' 5 'ECHO' 1 ;
  5357. 'FINSI' ;
  5358. *
  5359. 'FIN' ;
  5360.  
  5361.  
  5362.  
  5363.  
  5364.  
  5365.  
  5366.  
  5367.  
  5368.  
  5369.  
  5370.  
  5371.  
  5372.  
  5373.  
  5374.  
  5375.  
  5376.  
  5377.  
  5378.  
  5379.  
  5380.  
  5381.  

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