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. tnom . idx = 'CHAINE' cg &iidim &jidim ;
  243. 'FINSI' ;
  244. 'FIN' jidim ;
  245. 'FIN' iidim ;
  246. *
  247. lvid = 'LECT' ;
  248. dtm = 'DIME' tmot ;
  249. tchpo = 'TABLE' 'ESCLAVE' ;
  250. idx = 0 ;
  251. 'REPETER' itm dtm ;
  252. mcm = tmot . &itm ;
  253. numop = 1 ;
  254. numder = vdim ;
  255. numvar = 1 ;
  256. numdat = 0 ;
  257. numcof = 1 ;
  258. A = ININLIN numop numvar numdat numcof numder ;
  259. A . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
  260. A . 'VAR' . 1 . 'DISC' = 'CSTE' ;
  261. A . 'VAR' . 1 . 'VALEUR' = 1. ;
  262. A . 'COF' . 1 . 'COMPOR' = mcm ;
  263. A . 'COF' . 1 . 'LDAT' = lvid ;
  264. A . 1 . 1 . 0 = 'LECT' 1 ;
  265. numdat = 0 ;
  266. numcof = 0 ;
  267. B = ININLIN numop numvar numdat numcof numder ;
  268. B . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
  269. B . 'VAR' . 1 . 'DISC' = 'CSTE' ;
  270. B . 'VAR' . 1 . 'VALEUR' = 1. ;
  271. B . 1 . 1 . 0 = lvid ;
  272. cpo = NLIN gdisc _mt A B 'ERF1' methgau ;
  273. cpo = 'NOMC' (tnom . &itm) cpo ;
  274. idx = '+' idx 1 ;
  275. tchpo . idx = cpo ;
  276. 'FIN' itm ;
  277. imet = 'ET' tchpo ;
  278. 'RESPRO' imet ;
  279. *
  280. * End of procedure file CALIMET
  281. *
  282. 'FINPROC' ;
  283. *ENDPROCEDUR calimet
  284. *BEGINPROCEDUR defdd
  285. ************************************************************************
  286. * NOM : DEFDD
  287. * DESCRIPTION :
  288. *
  289. *
  290. *
  291. * LANGAGE : GIBIANE-CAST3M
  292. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  293. * mél : gounand@semt2.smts.cea.fr
  294. **********************************************************************
  295. * VERSION : v1, ??/??/2007, version initiale
  296. * HISTORIQUE : v1, ??/??/2007, création
  297. * HISTORIQUE :
  298. * HISTORIQUE :
  299. ************************************************************************
  300. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  301. * en cas de modification de ce sous-programme afin de faciliter
  302. * la maintenance !
  303. ************************************************************************
  304. *
  305. *
  306. 'DEBPROC' DEFDD ;
  307. *'ARGUMENT' _cmt*'MAILLAGE' ;
  308. *'ARGUMENT' cmt*'MAILLAGE' ;
  309. *'ARGUMENT' sur*'MAILLAGE' ;
  310. 'ARGUMENT' tdisc*'TABLE' ;
  311. 'ARGUMENT' idir/'ENTIER' ;
  312. 'SI' ('NON' ('EXISTE' idir)) ;
  313. idir = 0 ;
  314. 'FINSI' ;
  315. *
  316. NOMDEP = @STBL (TDISC . 'XN' . 'NOMINC') ;
  317. *
  318. vdim = 'VALEUR' 'DIME' ;
  319. DISCG = TDISC . 'GEOM' . 'DISC' ;
  320. _hau = tdisc . 'hau' . 'QUAF' ;
  321. hau = tdisc . 'hau' . discg ;
  322. vnor = GNOR _hau tdisc 'NPRI' discg 'FPRI' 1. 'NDUA' 'XN' ;
  323. * 'SI' ('EGA' vdim 3) ;
  324. * vnor = '*' vnor -1. ;
  325. * 'FINSI' ;
  326. vnorn = '/' vnor ('**' ('PSCAL' vnor vnor nomdep nomdep) 0.5 ) ;
  327. * trvec hau vnorn 'Vnorn' ;
  328. * Correction de vnorn aux extrémités
  329. phau = 'CHANGER' 'POI1' hau ;
  330. 'SI' ('EGA' idir 0) ;
  331. 'SI' ('EGA' vdim 2) ;
  332. mcorr = ('POIN' hau 'INITIAL')
  333. 'ET' ('POIN' hau 'FINAL') ;
  334. 'SINON' ;
  335. bhau = tdisc . 'bhau' . discg ;
  336. * mcorr = 'CONTOUR' sur ;
  337. *---------------pour 3D
  338. mcorr = bhau ;
  339. * 'TRACER' (hau 'ET' ('COULEUR' bhau roug)) ;
  340. 'FINSI' ;
  341. 'SINON' ;
  342. mcorr = hau ;
  343. 'FINSI' ;
  344. pmcorr = 'CHANGER' 'POI1' mcorr ;
  345. phaur = 'DIFF' phau pmcorr ;
  346. vnorn1 = 'REDU' vnorn phaur ;
  347. vvn = 'PROG' vdim * 0. ;
  348. 'REMPLACER' vvn vdim 1. ;
  349. * vnorn2 = 'MANUEL' 'CHPO' mcorr 2 'UX' 0. 'UY' 1. ;
  350. * 'LISTE' nomdep ;
  351. * 'LISTE' vvn ;
  352. vnorn2 = 'MANUEL' 'CHPO' mcorr nomdep vvn ;
  353. vnorn = vnorn1 '+' vnorn2 ;
  354. * trvec hau vnorn 'Vnorn2' ;
  355. 'RESPRO' vnorn ;
  356. 'FINPROC' ;
  357. *
  358. * End of procedure file DEFDD
  359. *
  360. *ENDPROCEDUR defdd
  361. *BEGINPROCEDUR defdfors
  362. ************************************************************************
  363. * NOM : DEFDFORS
  364. * DESCRIPTION :
  365. *
  366. *
  367. *
  368. * LANGAGE : GIBIANE-CAST3M
  369. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  370. * mél : gounand@semt2.smts.cea.fr
  371. **********************************************************************
  372. * VERSION : v1, ??/??/2007, version initiale
  373. * HISTORIQUE : v1, ??/??/2007, création
  374. * HISTORIQUE :
  375. * HISTORIQUE :
  376. ************************************************************************
  377. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  378. * en cas de modification de ce sous-programme afin de faciliter
  379. * la maintenance !
  380. ************************************************************************
  381. *
  382. *
  383. 'DEBPROC' DEFDFORS ;
  384. 'ARGUMENT' rmax/'FLOTTANT' ;
  385. 'ARGUMENT' lnclk/'LOGIQUE' ;
  386. *
  387. 'SI' ('NON' ('EXISTE' lnclk)) ;
  388. lnclk = FAUX ;
  389. 'FINSI' ;
  390. gmabs = gmass2 _hau tdisc 'NPRI' discv 'NDUA' discv ;
  391. 'SI' tbfor ;
  392. fblob
  393. desfb fvolb =
  394. REDUS hau
  395. fblonn
  396. desfd fpvolnn ;
  397. fblol
  398. desfl fvoll =
  399. KRESS gmabs
  400. fblob
  401. desfb fvolb ;
  402. 'SINON' ;
  403. fblob
  404. fgrab fsurb fforb
  405. desfb fvolb =
  406. REDUS hau
  407. fblonn
  408. fgrann fsurnn ffornn
  409. desfd fpvolnn ;
  410. fblol
  411. fgral fsurl fforl
  412. desfl fvoll =
  413. KRESS gmabs
  414. fblob
  415. fgrab fsurb fforb
  416. desfb fvolb ;
  417. 'FINSI' ;
  418. ihau = 'INVERSE' hau ;
  419. i=0 ;
  420. tabev = 'TABLE' ;
  421. tabt = 'TABLE' ;
  422. i = '+' i 1 ;
  423. tabev . i = 'EVOL' 'CHPO' fblol 'SCAL' ihau ;
  424. tabt . i = 'CHAINE' 'Fint' ;
  425. 'SI' ('NON' tbfor) ;
  426. i = '+' i 1 ;
  427. tabev . i = 'EVOL' 'CHPO' fgral 'SCAL' ihau ;
  428. tabt . i = 'CHAINE' 'RhoG' ;
  429. i = '+' i 1 ;
  430. tabev . i = 'EVOL' 'CHPO' fsurl 'SCAL' ihau ;
  431. tabt . i = 'CHAINE' 'Tsurf' ;
  432. i = '+' i 1 ;
  433. tabev . i = 'EVOL' 'CHPO' fforl 'SCAL' ihau ;
  434. tabt . i = 'CHAINE' 'SouP' ;
  435. 'FINSI' ;
  436. i = '+' i 1 ;
  437. tabev . i = 'EVOL' 'CHPO' desfl 'SCAL' ihau ;
  438. tabt . i = 'CHAINE' 'DES' ;
  439. i = '+' i 1 ;
  440. tabev . i = 'EVOL' 'CHPO' fvoll 'SCAL' ihau ;
  441. tabt . i = 'CHAINE' 'Incomp.' ;
  442. tix = 's' ; tiy = 'FY' ; tit = 'CHAINE' tiy '(' tix ')' ;
  443. 'SI' ('EXISTE' rmax) ;
  444. binf = '-' lav rmax ;
  445. bsup = '+' lav rmax ;
  446. dessevol (@STBL tabev) tabt tit tix tiy
  447. ('PROG' binf bsup) lnclk ;
  448. 'SINON' ;
  449. dessevol (@STBL tabev) tabt tit tix tiy
  450. lnclk ;
  451. 'FINSI' ;
  452. *'RESPRO' ..... ;
  453. *
  454. * End of procedure file DEFDFORS
  455. *
  456. 'FINPROC' ;
  457. *ENDPROCEDUR defdfors
  458. *BEGINPROCEDUR defmail
  459. ************************************************************************
  460. * NOM : DEFMAIL
  461. * DESCRIPTION :
  462. *
  463. *
  464. *
  465. * LANGAGE : GIBIANE-CAST3M
  466. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  467. * mél : gounand@semt2.smts.cea.fr
  468. **********************************************************************
  469. * VERSION : v1, 27/01/2011, version initiale
  470. * HISTORIQUE : v1, 27/01/2011, création
  471. * HISTORIQUE :
  472. * HISTORIQUE :
  473. ************************************************************************
  474. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  475. * en cas de modification de ce sous-programme afin de faciliter
  476. * la maintenance !
  477. ************************************************************************
  478. *
  479. *
  480. 'DEBPROC' DEFMAIL ;
  481. 'ARGUMENT' rsou*'FLOTTANT' ;
  482. 'ARGUMENT' lav*'FLOTTANT' ;
  483. 'ARGUMENT' lap*'FLOTTANT' ;
  484. 'ARGUMENT' prof*'FLOTTANT' ;
  485. 'ARGUMENT' raff*'ENTIER' ;
  486. *
  487. tdisc = JETMOD ;
  488. vdim = 'VALEUR' 'DIME' ;
  489. raf2 = '*' 2 raff ;
  490. raf4 = '*' 4 raff ;
  491. raf8 = '*' 8 raff ;
  492. raf16 = '*' 16 raff ;
  493. raf32 = '*' 32 raff ;
  494. *
  495. dr = '/' rsou raff ;
  496. dav = '/' lav raff ;
  497. dap = '/' lap raff ;
  498. drp = '/' prof raff ;
  499. *
  500. mlav = '*' lav -1. ;
  501. mrsou = '*' rsou -1. ;
  502. mprof = '*' prof -1. ;
  503. 'SI' ('EGA' vdim 2) ;
  504. pA = mlav mprof ; pB = mrsou mprof ; pC = 0. mprof ;
  505. pD = rsou mprof ; pE = lap mprof ;
  506. *pJ = mlav 0. ; pII = mrsou 0. ; pH = 0. -0.5 ;
  507. pJ = mlav 0. ; pII = mrsou 0. ; pH = 0. 0. ;
  508. pG = rsou 0. ; pF = lap 0. ;
  509. *
  510. lAB = 'DROIT' pA pB 'DINI' dav 'DFIN' dr ;
  511. lBC = 'DROIT' pB pC 'DINI' dr 'DFIN' dr ;
  512. lCD = 'DROIT' pC pD 'DINI' dr 'DFIN' dr ;
  513. lDE = 'DROIT' pD pE 'DINI' dr 'DFIN' dap ;
  514. lEF = 'DROIT' pE pF 'DINI' drp 'DFIN' dr ;
  515. lFG = 'DROIT' pF pG 'DINI' dap 'DFIN' dr ;
  516. lGH = 'DROIT' pG pH 'DINI' dr 'DFIN' dr ;
  517. lHII = 'DROIT' pH pII 'DINI' dr 'DFIN' dr ;
  518. lIIJ = 'DROIT' pII pJ 'DINI' dr 'DFIN' dav ;
  519. lJA = 'DROIT' pJ pA 'DINI' dr 'DFIN' drp ;
  520. *
  521. bas = lAB 'ET' lBC 'ET' lCD 'ET' lDE ;
  522. dro = lEF ;
  523. hau = LFG 'ET' lGH 'ET' lHII 'ET' lIIJ ;
  524. gau = lJA ;
  525. mtw = 'DALLER' bas dro hau gau ;
  526. cmtw = 'CONTOUR' mtw ;
  527. *'TRACER' mtw ;
  528. *
  529. _bas _dro _hau _gau _cmtw _mtw =
  530. QUAFME bas dro hau gau cmtw mtw ;
  531. 'ELIMINATION'
  532. (_bas 'ET' _dro 'ET' _hau 'ET' _gau
  533. 'ET' _cmtw 'ET' _mtw)
  534. (1.D-5 '*' rsou) ;
  535. 'FINSI' ;
  536. 'SI' ('EGA' vdim 3) ;
  537. pA = mlav 0. mprof ; pB = mrsou 0. mprof ; pC = 0. 0. mprof ;
  538. pD = rsou 0. mprof ; pE = lap 0. mprof ;
  539. *pJ = mlav 0. ; pII = mrsou 0. ; pH = 0. -0.5 ;
  540. pJ = mlav 0. 0. ; pII = mrsou 0. 0. ; pH = 0. 0. 0. ;
  541. pG = rsou 0. 0. ; pF = lap 0. 0. ;
  542. *
  543. lAB = 'DROIT' pA pB 'DINI' dav 'DFIN' dr ;
  544. lBC = 'DROIT' pB pC 'DINI' dr 'DFIN' dr ;
  545. lCD = 'DROIT' pC pD 'DINI' dr 'DFIN' dr ;
  546. lDE = 'DROIT' pD pE 'DINI' dr 'DFIN' dap ;
  547. lEF = 'DROIT' pE pF 'DINI' drp 'DFIN' dr ;
  548. lFG = 'DROIT' pF pG 'DINI' dap 'DFIN' dr ;
  549. lGH = 'DROIT' pG pH 'DINI' dr 'DFIN' dr ;
  550. lHII = 'DROIT' pH pII 'DINI' dr 'DFIN' dr ;
  551. lIIJ = 'DROIT' pII pJ 'DINI' dr 'DFIN' dav ;
  552. lJA = 'DROIT' pJ pA 'DINI' dr 'DFIN' drp ;
  553. *
  554. bas2 = lAB 'ET' lBC 'ET' lCD 'ET' lDE ;
  555. dro2 = lEF ;
  556. hau2 = LFG 'ET' lGH 'ET' lHII 'ET' lIIJ ;
  557. gau2 = lJA ;
  558. fro = 'DALLER' bas2 dro2 hau2 gau2 ;
  559. dhau = 'INVERSE' hau2 ;
  560. * cmtw2 = 'CONTOUR' mtw2 ;
  561. *
  562. vtran = 0. lav 0. ;
  563. * vtran = 0. ('*' rsou 2.) 0. ;
  564. pH2 = 'PLUS' pH (0. rsou 0.) ;
  565. pH3 = 'PLUS' pH vtran ;
  566. lgen1 = 'DROIT' pH pH2 'DINI' dr 'DFIN' dr ;
  567. lgen2 = 'DROIT' pH2 pH3 'DINI' dr 'DFIN' dav ;
  568. lgen = lgen1 'ET' lgen2 ;
  569. * lgen = 'DROIT' 1 pH pH3 ;
  570. *
  571. rea = 'PLUS' fro vtran ;
  572. bas = 'GENERATRICE' bas2 lgen ;
  573. dro = 'GENERATRICE' dro2 lgen ;
  574. hau = 'GENERATRICE' hau2 lgen ;
  575. gau = 'GENERATRICE' gau2 lgen ;
  576. mtw = 'VOLUME' fro 'GENE' lgen ;
  577. cmtw = 'ENVELOPPE' mtw ;
  578. pint = 0. rsou ('/' mprof 2.) ;
  579. cmtw = 'ORIENTER' cmtw 'POIN' pint ;
  580. bhau1 = lgen 'PLUS' pJ ;
  581. bhau2 = lgen 'PLUS' pF ;
  582. bhau = bhau1 'ET' bhau2 ;
  583. *
  584. * 'TRACER' mtw ;
  585. *
  586. _bas _dro _hau _dhau _bhau _gau _fro _rea _cmtw _mtw =
  587. QUAFME bas dro hau dhau bhau gau fro rea cmtw mtw ;
  588. 'ELIMINATION'
  589. (_bas 'ET' _dro 'ET' _hau 'ET' _dhau 'ET' _bhau 'ET' _gau
  590. 'ET' _fro 'ET' _rea 'ET' _cmtw 'ET' _mtw)
  591. (1.D-5 '*' rsou) ;
  592. 'FINSI' ;
  593. *
  594. * vnor = GNOR _cmtw tdisc 'NPRI' discg 'FPRI' 1. 'NDUA' 'XN' ;
  595. * NOMDEP = @STBL (TDISC . 'XN' . 'NOMINC') ;
  596. * vnorn = '/' vnor ('**' ('PSCAL' vnor vnor nomdep nomdep) 0.5 ) ;
  597. * trvec cmtw vnorn 'Vnorn' ;
  598. *
  599. tdisc . 'mtw' = 'TABLE' ;
  600. tdisc . 'mtw' .'QUAF' = _mtw ; tdisc . 'mtw' .'LINE' = mtw ;
  601. tdisc . 'cmtw' = 'TABLE' ;
  602. tdisc . 'cmtw' .'QUAF' = _cmtw ; tdisc . 'cmtw' .'LINE' = cmtw ;
  603. tdisc . 'bas' = 'TABLE' ;
  604. tdisc . 'bas' .'QUAF' = _bas ; tdisc . 'bas' .'LINE' = bas ;
  605. tdisc . 'dro' = 'TABLE' ;
  606. tdisc . 'dro' .'QUAF' = _dro ; tdisc . 'dro' .'LINE' = dro ;
  607. tdisc . 'hau' = 'TABLE' ;
  608. tdisc . 'hau' .'QUAF' = _hau ; tdisc . 'hau' .'LINE' = hau ;
  609. tdisc . 'gau' = 'TABLE' ;
  610. tdisc . 'gau' .'QUAF' = _gau ; tdisc . 'gau' .'LINE' = gau ;
  611. 'SI' ('EGA' vdim 3) ;
  612. tdisc . 'fro' = 'TABLE' ;
  613. tdisc . 'fro' .'QUAF' = _fro ; tdisc . 'fro' .'LINE' = fro ;
  614. tdisc . 'rea' = 'TABLE' ;
  615. tdisc . 'rea' .'QUAF' = _rea ; tdisc . 'rea' .'LINE' = rea ;
  616. tdisc . 'dhau' = 'TABLE' ;
  617. tdisc . 'dhau' .'QUAF' = _dhau ; tdisc . 'dhau' .'LINE' = dhau ;
  618. tdisc . 'bhau' = 'TABLE' ;
  619. tdisc . 'bhau' .'QUAF' = _bhau ; tdisc . 'bhau' .'LINE' = bhau ;
  620. 'FINSI' ;
  621. *
  622. 'RESPRO' tdisc ;
  623. *
  624. * End of procedure file DEFMAIL
  625. *
  626. 'FINPROC' ;
  627. *ENDPROCEDUR defmail
  628. *BEGINPROCEDUR defqfors
  629. ************************************************************************
  630. * NOM : DEFQFORS
  631. * DESCRIPTION :
  632. *
  633. *
  634. *
  635. * LANGAGE : GIBIANE-CAST3M
  636. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  637. * mél : gounand@semt2.smts.cea.fr
  638. **********************************************************************
  639. * VERSION : v1, ??/??/2007, version initiale
  640. * HISTORIQUE : v1, ??/??/2007, création
  641. * HISTORIQUE :
  642. * HISTORIQUE :
  643. ************************************************************************
  644. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  645. * en cas de modification de ce sous-programme afin de faciliter
  646. * la maintenance !
  647. ************************************************************************
  648. *
  649. *
  650. 'DEBPROC' DEFQFORS ;
  651. 'ARGUMENT' rmax/'FLOTTANT' ;
  652. 'ARGUMENT' lnclk/'LOGIQUE' ;
  653. *
  654. 'SI' ('NON' ('EXISTE' lnclk)) ;
  655. lnclk = FAUX ;
  656. 'FINSI' ;
  657. gmabs = gmass2 _hau tdisc 'NPRI' discv 'NDUA' discv ;
  658. 'SI' tbfor ;
  659. fpreb frigb fugrb desfb
  660. fpgrab ftsurb fpforb
  661. * ftanrb
  662. fblonb fbloxb fbloyb =
  663. REDUS hau
  664. fpre frig fugr desfq
  665. fpgra ftsur fpfor
  666. * ftanr
  667. fblon fblox fbloy ;
  668. 'SINON' ;
  669. fpreb frigb fugrb desfb
  670. fblonb fbloxb fbloyb =
  671. REDUS hau
  672. fpre frig fugr desfq
  673. fblon fblox fbloy ;
  674. 'FINSI' ;
  675. vnor = DEFDD tdisc 0 ;
  676. *
  677. * Décomposition en composante normale et tangentielle
  678. *
  679. 'SI' tbfor ;
  680. fpren fpret frign frigt fugrn fugrt desfn desft
  681. fgran fgrat fsurn fsurt fforn ffort
  682. * ftanrn ftanrt
  683. fblonn fblont fbloxn fbloxt fbloyn fbloyt
  684. = NORTANS vnor
  685. fpreb frigb fugrb desfb
  686. fpgra ftsur fpfor
  687. * ftanr
  688. fblonb fbloxb fbloyb ;
  689. *
  690. fpren fpret frign frigt fugrn fugrt desfn desft
  691. fgran fgrat fsurn fsurt fforn ffort
  692. * ftanrn ftanrt
  693. fblonn fblont fbloxn fbloxt fbloyn fbloyt
  694. = KRESS gmabs
  695. fpren fpret frign frigt fugrn fugrt desfn desft
  696. fgran fgrat fsurn fsurt fforn ffort
  697. * ftanrn ftanrt
  698. fblonn fblont fbloxn fbloxt fbloyn fbloyt
  699. ;
  700. 'SINON' ;
  701. fpren fpret frign frigt fugrn fugrt desfn desft
  702. fblonn fblont fbloxn fbloxt fbloyn fbloyt
  703. = NORTANS vnor
  704. fpreb frigb fugrb desfb
  705. fblonb fbloxb fbloyb ;
  706. *
  707. fpren fpret frign frigt fugrn fugrt desfn desft
  708. fblonn fblont fbloxn fbloxt fbloyn fbloyt
  709. = KRESS gmabs
  710. fpren fpret frign frigt fugrn fugrt desfn desft
  711. fblonn fblont fbloxn fbloxt fbloyn fbloyt
  712. ;
  713. 'FINSI' ;
  714. ihau = 'INVERSE' hau ;
  715. i=0 ;
  716. tabev = 'TABLE' ;
  717. tabt = 'TABLE' ;
  718. i = '+' i 1 ;
  719. tabev . i = 'EVOL' 'CHPO' fpret 'SCAL' ihau ;
  720. tabt . i = 'CHAINE' 'GradP' ;
  721. i = '+' i 1 ;
  722. tabev . i = 'EVOL' 'CHPO' frigt 'SCAL' ihau ;
  723. tabt . i = 'CHAINE' 'LapnU' ;
  724. i = '+' i 1 ;
  725. tabev . i = 'EVOL' 'CHPO' fugrt 'SCAL' ihau ;
  726. tabt . i = 'CHAINE' 'UgradU' ;
  727. i = '+' i 1 ;
  728. tabev . i = 'EVOL' 'CHPO' desft 'SCAL' ihau ;
  729. tabt . i = 'CHAINE' 'DES' ;
  730. 'SI' tbfor ;
  731. i = '+' i 1 ;
  732. tabev . i = 'EVOL' 'CHPO' fgrat 'SCAL' ihau ;
  733. tabt . i = 'CHAINE' 'Gravi' ;
  734. i = '+' i 1 ;
  735. tabev . i = 'EVOL' 'CHPO' fsurt 'SCAL' ihau ;
  736. tabt . i = 'CHAINE' 'T. Sur' ;
  737. i = '+' i 1 ;
  738. tabev . i = 'EVOL' 'CHPO' ffort 'SCAL' ihau ;
  739. tabt . i = 'CHAINE' 'Sou. Pr' ;
  740. * i = '+' i 1 ;
  741. * tabev . i = 'EVOL' 'CHPO' ftanrt 'SCAL' ihau ;
  742. * tabt . i = 'CHAINE' 'Sor. lib.' ;
  743. 'FINSI' ;
  744. i = '+' i 1 ;
  745. tabev . i = 'EVOL' 'CHPO' fblont 'SCAL' ihau ;
  746. tabt . i = 'CHAINE' 'BlocN' ;
  747. i = '+' i 1 ;
  748. tabev . i = 'EVOL' 'CHPO' fbloxt 'SCAL' ihau ;
  749. tabt . i = 'CHAINE' 'BlocX' ;
  750. i = '+' i 1 ;
  751. tabev . i = 'EVOL' 'CHPO' fbloyt 'SCAL' ihau ;
  752. tabt . i = 'CHAINE' 'BlocY' ;
  753. tix = 's' ; tiy = 'Ftan' ; tit = 'CHAINE' tiy '(' tix ')' ;
  754. 'SI' ('EXISTE' rmax) ;
  755. binf = '-' lav rmax ;
  756. bsup = '+' lav rmax ;
  757. dessevol (@STBL tabev) tabt tit tix tiy
  758. ('PROG' binf bsup) lnclk ;
  759. 'SINON' ;
  760. dessevol (@STBL tabev) tabt tit tix tiy
  761. lnclk ;
  762. 'FINSI' ;
  763. i=0 ;
  764. tabev = 'TABLE' ;
  765. tabt = 'TABLE' ;
  766. i = '+' i 1 ;
  767. tabev . i = 'EVOL' 'CHPO' fpren 'SCAL' ihau ;
  768. tabt . i = 'CHAINE' 'GradP' ;
  769. i = '+' i 1 ;
  770. tabev . i = 'EVOL' 'CHPO' frign 'SCAL' ihau ;
  771. tabt . i = 'CHAINE' 'LapnU' ;
  772. i = '+' i 1 ;
  773. tabev . i = 'EVOL' 'CHPO' fugrn 'SCAL' ihau ;
  774. tabt . i = 'CHAINE' 'UgradU' ;
  775. i = '+' i 1 ;
  776. tabev . i = 'EVOL' 'CHPO' desfn 'SCAL' ihau ;
  777. tabt . i = 'CHAINE' 'DES' ;
  778. 'SI' tbfor ;
  779. i = '+' i 1 ;
  780. tabev . i = 'EVOL' 'CHPO' fgran 'SCAL' ihau ;
  781. tabt . i = 'CHAINE' 'RhoG' ;
  782. i = '+' i 1 ;
  783. tabev . i = 'EVOL' 'CHPO' fsurn 'SCAL' ihau ;
  784. tabt . i = 'CHAINE' 'Tsurf' ;
  785. i = '+' i 1 ;
  786. tabev . i = 'EVOL' 'CHPO' fforn 'SCAL' ihau ;
  787. tabt . i = 'CHAINE' 'Sou. P' ;
  788. * i = '+' i 1 ;
  789. * tabev . i = 'EVOL' 'CHPO' ftanrn 'SCAL' ihau ;
  790. * tabt . i = 'CHAINE' 'Sor. lib.' ;
  791. 'FINSI' ;
  792. i = '+' i 1 ;
  793. tabev . i = 'EVOL' 'CHPO' fblonn 'SCAL' ihau ;
  794. tabt . i = 'CHAINE' 'BlocN' ;
  795. i = '+' i 1 ;
  796. tabev . i = 'EVOL' 'CHPO' fbloxn 'SCAL' ihau ;
  797. tabt . i = 'CHAINE' 'BlocX' ;
  798. i = '+' i 1 ;
  799. tabev . i = 'EVOL' 'CHPO' fbloyn 'SCAL' ihau ;
  800. tabt . i = 'CHAINE' 'BlocY' ;
  801. tix = 's' ; tiy = 'Fnor' ; tit = 'CHAINE' tiy '(' tix ')' ;
  802. 'SI' ('EXISTE' rmax) ;
  803. binf = '-' lav rmax ;
  804. bsup = '+' lav rmax ;
  805. dessevol (@STBL tabev) tabt tit tix tiy
  806. ('PROG' binf bsup) lnclk ;
  807. 'SINON' ;
  808. dessevol (@STBL tabev) tabt tit tix tiy
  809. lnclk ;
  810. 'FINSI' ;
  811. *
  812. * End of procedure file DEFQFORS
  813. *
  814. 'FINPROC' ;
  815. *ENDPROCEDUR defqfors
  816. *BEGINPROCEDUR defsumm
  817. ************************************************************************
  818. * NOM : DEFSUMM
  819. * DESCRIPTION :
  820. *
  821. *
  822. *
  823. * LANGAGE : GIBIANE-CAST3M
  824. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  825. * mél : gounand@semt2.smts.cea.fr
  826. **********************************************************************
  827. * VERSION : v1, ??/??/2007, version initiale
  828. * HISTORIQUE : v1, ??/??/2007, création
  829. * HISTORIQUE :
  830. * HISTORIQUE :
  831. ************************************************************************
  832. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  833. * en cas de modification de ce sous-programme afin de faciliter
  834. * la maintenance !
  835. ************************************************************************
  836. *
  837. *
  838. 'DEBPROC' DEFSUMM ;
  839. 'MESSAGE' ('CHAINE' 'Parametres physiques :') ;
  840. 'MESSAGE' ('CHAINE' '**********************') ;
  841. *
  842. 'MESSAGE' ('CHAINE' 'Parametres adimensionnels :') ;
  843. 'MESSAGE' ('CHAINE' '***************************') ;
  844. 'MESSAGE' ('CHAINE' ' Nombre dEuler = ' (formar Eu 3)) ;
  845. 'MESSAGE' ('CHAINE' ' Nombre de Reynolds = ' (formar Re 3)) ;
  846. 'MESSAGE' ('CHAINE' ' Nombre de Froude*Euler = ' (formar FrEu 3)) ;
  847. 'MESSAGE' ('CHAINE' ' Nombre de Weber = ' (formar We 3)) ;
  848. 'MESSAGE' ('CHAINE' 'Numérique :') ;
  849. 'MESSAGE' ('CHAINE' '-----------') ;
  850. 'MESSAGE' ('CHAINE' 'raff=' raff
  851. ' nelem= ' ('NBEL' mtw) ' npo= ' ('NBNO' mtw)) ;
  852. 'MESSAGE' ('CHAINE' 'itcou= ' itcou ' nitermax=' nitermax) ;
  853. 'MESSAGE' ('CHAINE' 'nitn= ' nitn ' omegn=' (formar omegn 2)) ;
  854. 'MESSAGE' ('CHAINE' 'omegd=' (formar omegd 2)) ;
  855. 'MESSAGE' ('CHAINE' 'nomdir=' nomdir) ;
  856. 'MESSAGE' ('CHAINE' 'nomfic=' nomfic) ;
  857. *
  858. * End of procedure file DEFSUMM
  859. *
  860. 'FINPROC' ;
  861. *ENDPROCEDUR defsumm
  862. *BEGINPROCEDUR defvsurf
  863. ************************************************************************
  864. * NOM : DEFVSURF
  865. * DESCRIPTION :
  866. *
  867. *
  868. *
  869. * LANGAGE : GIBIANE-CAST3M
  870. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  871. * mél : gounand@semt2.smts.cea.fr
  872. **********************************************************************
  873. * VERSION : v1, ??/??/2007, version initiale
  874. * HISTORIQUE : v1, ??/??/2007, création
  875. * HISTORIQUE :
  876. * HISTORIQUE :
  877. ************************************************************************
  878. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  879. * en cas de modification de ce sous-programme afin de faciliter
  880. * la maintenance !
  881. ************************************************************************
  882. *
  883. *
  884. 'DEBPROC' DEFVSURF ;
  885. 'ARGUMENT' rmax/'FLOTTANT' ;
  886. 'ARGUMENT' lnclk/'LOGIQUE' ;
  887. *
  888. 'SI' ('NON' ('EXISTE' lnclk)) ;
  889. lnclk = FAUX ;
  890. 'FINSI' ;
  891. vdim = 'VALEUR' 'DIME' ;
  892. 'SI' ('EGA' vdim 2) ;
  893. ihau = 'INVERSE' hau ;
  894. 'SINON' ;
  895. ihau = dhau ;
  896. 'FINSI' ;
  897. i=0 ;
  898. tabev = 'TABLE' ;
  899. tabt = 'TABLE' ;
  900. i = '+' i 1 ;
  901. rhau = 'EXTRAIRE' ('EVOL' 'CHPO' ('COORDONNEE' 1 hau) 'SCAL' ihau)
  902. 'ORDO' ;
  903. hv = 'REDU' vit ihau ;
  904. NOMDEP = @STBL (TDISC . 'XN' . 'NOMINC') ;
  905. nhv = '**' ('PSCAL' vit vit nomdep nomdep) 0.5 ;
  906. zhau = 'EXTRAIRE' ('EVOL' 'CHPO' nhv 'SCAL' ihau) 'ORDO' ;
  907. tabev . i = 'EVOL' 'MANU' rhau zhau ;
  908. tabt . i = 'CHAINE' '|V| surf' ;
  909. tix = 's' ; tiy = '|V|' ; tit = 'CHAINE' tiy '(' tix ')' ;
  910. 'SI' ('EXISTE' rmax) ;
  911. binf = '-' 0. rmax ;
  912. bsup = '+' 0. rmax ;
  913. dessevol (@STBL tabev) tabt tit tix tiy
  914. ('PROG' binf bsup) lnclk ;
  915. 'SINON' ;
  916. dessevol (@STBL tabev) tabt tit tix tiy
  917. lnclk ;
  918. 'FINSI' ;
  919. *'SINON' ;
  920. * 'SI' ('EXISTE' rmax) ;
  921. * xhau = 'COORDONNEE' 1 hau ;
  922. * yhau = 'COORDONNEE' 2 hau ;
  923. * rhau = '**' ('+' ('**' xhau 2) ('**' yhau 2)) 0.5 ;
  924. * phau = 'POIN' rhau 'INFERIEUR' rmax ;
  925. * redhau = 'ELEM' hau 'APPUYE' 'LARGEMENT' phau ;
  926. * 'SINON' ;
  927. * redhau = hau ;
  928. * 'FINSI' ;
  929. * 'SI' lnclk ;
  930. * 'TRACER' 'CACH' redhau 'TITR' 'Surface' 'NCLK' ;
  931. * 'SINON' ;
  932. * 'TRACER' 'CACH' redhau 'TITR' 'Surface' 'NCLK' ;
  933. * 'FINSI' ;
  934. *'FINSI' ;
  935. *
  936. * End of procedure file DEFVSURF
  937. *
  938. 'FINPROC' ;
  939. *ENDPROCEDUR defvsurf
  940. *BEGINPROCEDUR defzsurf
  941. ************************************************************************
  942. * NOM : DEFZSURF
  943. * DESCRIPTION :
  944. *
  945. *
  946. *
  947. * LANGAGE : GIBIANE-CAST3M
  948. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  949. * mél : gounand@semt2.smts.cea.fr
  950. **********************************************************************
  951. * VERSION : v1, ??/??/2007, version initiale
  952. * HISTORIQUE : v1, ??/??/2007, création
  953. * HISTORIQUE :
  954. * HISTORIQUE :
  955. ************************************************************************
  956. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  957. * en cas de modification de ce sous-programme afin de faciliter
  958. * la maintenance !
  959. ************************************************************************
  960. *
  961. *
  962. 'DEBPROC' DEFZSURF ;
  963. 'ARGUMENT' rmax/'FLOTTANT' ;
  964. 'ARGUMENT' lnclk/'LOGIQUE' ;
  965. *
  966. 'SI' ('NON' ('EXISTE' lnclk)) ;
  967. lnclk = FAUX ;
  968. 'FINSI' ;
  969. vdim = 'VALEUR' 'DIME' ;
  970. 'SI' ('EGA' vdim 2) ;
  971. ihau = 'INVERSE' hau ;
  972. 'SINON' ;
  973. ihau = dhau ;
  974. 'FINSI' ;
  975. i=0 ;
  976. tabev = 'TABLE' ;
  977. tabt = 'TABLE' ;
  978. i = '+' i 1 ;
  979. rhau = 'EXTRAIRE' ('EVOL' 'CHPO' ('COORDONNEE' 1 hau) 'SCAL' ihau)
  980. 'ORDO' ;
  981. zhau = 'EXTRAIRE' ('EVOL' 'CHPO' ('COORDONNEE' vdim hau)
  982. 'SCAL' ihau) 'ORDO' ;
  983. tabev . i = 'EVOL' 'MANU' rhau zhau ;
  984. tabt . i = 'CHAINE' 'z surf' ;
  985. tix = 's' ; tiy = 'z' ; tit = 'CHAINE' tiy '(' tix ')' ;
  986. 'SI' ('EXISTE' rmax) ;
  987. binf = '-' 0. rmax ;
  988. bsup = '+' 0. rmax ;
  989. dessevol (@STBL tabev) tabt tit tix tiy
  990. ('PROG' binf bsup) lnclk ;
  991. 'SINON' ;
  992. dessevol (@STBL tabev) tabt tit tix tiy
  993. lnclk ;
  994. 'FINSI' ;
  995. *'SINON' ;
  996. * 'SI' ('EXISTE' rmax) ;
  997. * xhau = 'COORDONNEE' 1 hau ;
  998. * yhau = 'COORDONNEE' 2 hau ;
  999. * rhau = '**' ('+' ('**' xhau 2) ('**' yhau 2)) 0.5 ;
  1000. * phau = 'POIN' rhau 'INFERIEUR' rmax ;
  1001. * redhau = 'ELEM' hau 'APPUYE' 'LARGEMENT' phau ;
  1002. * 'SINON' ;
  1003. * redhau = hau ;
  1004. * 'FINSI' ;
  1005. * 'SI' lnclk ;
  1006. * 'TRACER' 'CACH' redhau 'TITR' 'Surface' 'NCLK' ;
  1007. * 'SINON' ;
  1008. * 'TRACER' 'CACH' redhau 'TITR' 'Surface' 'NCLK' ;
  1009. * 'FINSI' ;
  1010. *'FINSI' ;
  1011. *
  1012. * End of procedure file DEFZSURF
  1013. *
  1014. 'FINPROC' ;
  1015. *ENDPROCEDUR defzsurf
  1016. *BEGINPROCEDUR dessevol
  1017. ************************************************************************
  1018. * NOM : DESSEVOL
  1019. * DESCRIPTION : Dessine des évolutions : choisit automatiquement
  1020. * les options, marqueurs, couleurs...
  1021. *
  1022. *
  1023. * LANGAGE : GIBIANE-CAST3M
  1024. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1025. * mél : gounand@semt2.smts.cea.fr
  1026. **********************************************************************
  1027. * VERSION : v1, 16/11/2004, version initiale
  1028. * HISTORIQUE : v1, 16/11/2004, création
  1029. * HISTORIQUE :
  1030. * HISTORIQUE :
  1031. ************************************************************************
  1032. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1033. * en cas de modification de ce sous-programme afin de faciliter
  1034. * la maintenance !
  1035. ************************************************************************
  1036. *
  1037. *
  1038. 'DEBPROC' DESSEVOL ;
  1039. 'ARGUMENT' evtot*'EVOLUTION' ;
  1040. 'ARGUMENT' tabt*'TABLE' ;
  1041. 'ARGUMENT' tit*'MOT' ;
  1042. 'ARGUMENT' tix*'MOT' ;
  1043. 'ARGUMENT' tiy*'MOT' ;
  1044. 'ARGUMENT' lnclk/'LOGIQUE' ;
  1045. 'ARGUMENT' nb/'ENTIER' ;
  1046. 'ARGUMENT' lx/'LISTREEL' ;
  1047. *
  1048. 'SI' ('NON' ('EXISTE' lnclk)) ;
  1049. lnclk = FAUX ;
  1050. 'FINSI' ;
  1051. *
  1052. * nb = 0 : noir et blanc
  1053. * nb = 1 : couleur
  1054. * nb = 2 : couleur + marqueurs
  1055. * nb = 3 : couleur + marqueurs + tirets
  1056. * nb = 4 : couleur + marqueurs regu
  1057. * nb = 5 : couleur + marqueurs regu + tirets
  1058. * nb = 6 : nb + marqueurs regu + tirets
  1059. * nb = 7 : nb + marqueurs
  1060. * nb = 8 : nb + marqueurs regu
  1061. *
  1062. 'SI' ('NON' ('EXISTE' nb)) ;
  1063. nb = 3 ;
  1064. 'FINSI' ;
  1065. *
  1066. nt = 'DIME' tabt ;
  1067. nev = 'DIME' evtot ;
  1068. *
  1069. * Attention, dans evtot, il y a une évolution avec des noms de points ?
  1070. *
  1071. *'SI' ('NEG' nev nt) ;
  1072. * cherr = 'CHAINE' 'Evolution and title table : not same dim.' ;
  1073. * 'ERREUR' cherr ;
  1074. *'FINSI' ;
  1075. *
  1076. tev = 'TABLE' ;
  1077. tev . 'TITRE' = tabt ;
  1078. *
  1079. toto = 'TABLE' ;
  1080. *
  1081. *lcoul = 'MOTS' 'TURQ' 'VERT' 'JAUN' 'ROSE' 'ROUG' 'BLEU' ;
  1082. 'SI' ('EGA' ('VALEUR' 'TRAC') 'PSC') ;
  1083. lcoul = 'MOTS' 'BLEU' 'ROUG' 'VERT' 'VIOL' 'OLIV' 'ORAN' ;
  1084. 'SINON' ;
  1085. lcoul = 'MOTS' 'TURQ' 'VERT' 'JAUN' 'ROSE' 'ROUG' 'BLEU' ;
  1086. 'FINSI' ;
  1087. lmarq = 'MOTS' 'TRID' 'TRIU' 'LOSA' 'CARR' 'ETOI' 'PLUS' 'CROI'
  1088. 'TRIL' 'TRIR' ;
  1089. ltirr = 'MOTS' 'TIRR' 'TIRC' 'TIRL' 'TIRM' ;
  1090. *
  1091. lnb = 'LECT' 0 6 7 8 ;
  1092. *'SI' ('OU' ('EGA' nb 0) ('EGA' nb 6)) ;
  1093. 'SI' (dans ('LECT' nb) lnb) ;
  1094. ev2 = evtot ;
  1095. 'SINON' ;
  1096. icou = 0 ;
  1097. 'REPETER' iev nev ;
  1098. ii = &iev ;
  1099. evi = 'EXTRAIRE' evtot 'COUR' ii ;
  1100. 'SI' ('NEG' ('TYPE' ('EXTRAIRE' evi 'ORDO')) 'LISTMOTS') ;
  1101. icou = '+' icou 1 ;
  1102. 'FINSI' ;
  1103. * ii2 = '/' ('+' ii 1) 2 ;
  1104. * ci = EXMOMOD lcoul ii2 ;
  1105. * ci = EXMOMOD lcoul ii ;
  1106. ci = EXMOMOD lcoul icou ;
  1107. APPEND toto 'EVOLUTION' ('COULEUR' evi ci) ;
  1108. 'FIN' iev ;
  1109. ev2 = toto . 'EVOLUTION' ;
  1110. 'FINSI' ;
  1111. *
  1112. 'REPETER' iev nev ;
  1113. ii = &iev ;
  1114. mi = EXMOMOD lmarq ii ;
  1115. ti = EXMOMOD ltirr ii ;
  1116. 'SI' ('OU' ('EGA' nb 2) ('EGA' nb 7)) ;
  1117. tev . ii = 'CHAINE' 'MARQ ' mi ;
  1118. 'FINSI' ;
  1119. 'SI' ('EGA' nb 3) ;
  1120. tev . ii = 'CHAINE' 'MARQ ' mi ' ' ti ;
  1121. 'FINSI' ;
  1122. 'SI' ('OU' ('EGA' nb 4) ('EGA' nb 8)) ;
  1123. tev . ii = 'CHAINE' 'MARQ ' mi ' REGU' ;
  1124. 'FINSI' ;
  1125. 'SI' ('OU' ('EGA' nb 5) ('EGA' nb 6)) ;
  1126. tev . ii = 'CHAINE' 'MARQ ' mi ' ' ti ' REGU' ;
  1127. 'FINSI' ;
  1128. 'FIN' iev ;
  1129. *
  1130. 'SI' ('EXISTE' lx) ;
  1131. dim4 = 'EGA' ('DIME' lx) 4 ;
  1132. xmin = 'EXTRAIRE' lx 1 ; xmax = 'EXTRAIRE' lx 2 ;
  1133. 'SI' dim4 ;
  1134. ymin = 'EXTRAIRE' lx 3 ; ymax = 'EXTRAIRE' lx 4 ;
  1135. 'FINSI' ;
  1136. 'SI' dim4 ;
  1137. 'SI' lnclk ;
  1138. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
  1139. 'XBOR' xmin xmax 'YBOR' ymin ymax 'NCLK' motopt ;
  1140. 'SINON' ;
  1141. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
  1142. 'XBOR' xmin xmax 'YBOR' ymin ymax motopt ;
  1143. 'FINSI' ;
  1144. 'SINON' ;
  1145. 'SI' lnclk ;
  1146. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
  1147. 'XBOR' xmin xmax 'NCLK' motopt ;
  1148. 'SINON' ;
  1149. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
  1150. 'XBOR' xmin xmax motopt ;
  1151. 'FINSI' ;
  1152. 'FINSI' ;
  1153. 'SINON' ;
  1154. 'SI' lnclk ;
  1155. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
  1156. 'NCLK' motopt ;
  1157. 'SINON' ;
  1158. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
  1159. motopt ;
  1160. 'FINSI' ;
  1161. 'FINSI' ;
  1162. *
  1163. * End of procedure file DESSEVOL
  1164. *
  1165. 'FINPROC' ;
  1166. *ENDPROCEDUR dessevol
  1167. *BEGINPROCEDUR errrel
  1168. ************************************************************************
  1169. * NOM : ERRREL
  1170. * DESCRIPTION : Calcul d'une erreur relative
  1171. *
  1172. *
  1173. *
  1174. * LANGAGE : GIBIANE-CAST3M
  1175. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1176. * mél : gounand@semt2.smts.cea.fr
  1177. **********************************************************************
  1178. * VERSION : v1, 23/04/2003, version initiale
  1179. * HISTORIQUE : v1, 23/04/2003, création
  1180. * HISTORIQUE :
  1181. * HISTORIQUE :
  1182. ************************************************************************
  1183. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1184. * en cas de modification de ce sous-programme afin de faciliter
  1185. * la maintenance !
  1186. ************************************************************************
  1187. *
  1188. *
  1189. 'DEBPROC' ERRREL ;
  1190. 'ARGUMENT' val*'FLOTTANT' ;
  1191. 'ARGUMENT' valref*'FLOTTANT' ;
  1192. *
  1193. 'SI' ('<' ('ABS' valref) 1.D-10) ;
  1194. echref = 1.D0 ;
  1195. 'SINON' ;
  1196. echref = valref ;
  1197. 'FINSI' ;
  1198. *
  1199. errabs = 'ABS' ('/' ('-' val valref) echref);
  1200. *
  1201. 'RESPRO' errabs ;
  1202. *
  1203. * End of procedure file ERRREL
  1204. *
  1205. 'FINPROC' ;
  1206. *ENDPROCEDUR errrel
  1207. *BEGINPROCEDUR exmomod
  1208. ************************************************************************
  1209. * NOM : EXMOMOD
  1210. * DESCRIPTION : Extraction d'un mot d'un listmots
  1211. *
  1212. *
  1213. *
  1214. * LANGAGE : GIBIANE-CAST3M
  1215. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1216. * mél : gounand@semt2.smts.cea.fr
  1217. **********************************************************************
  1218. * VERSION : v1, 23/06/2003, version initiale
  1219. * HISTORIQUE : v1, 23/06/2003, création
  1220. * HISTORIQUE :
  1221. * HISTORIQUE :
  1222. ************************************************************************
  1223. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1224. * en cas de modification de ce sous-programme afin de faciliter
  1225. * la maintenance !
  1226. ************************************************************************
  1227. *
  1228. *
  1229. 'DEBPROC' EXMOMOD ;
  1230. 'ARGUMENT' lm*'LISTMOTS' i*'ENTIER' ;
  1231. j = 'DIME' lm ;
  1232. k = '+' (MODULO ('-' i 1) j) 1 ;
  1233. lemot = 'EXTRAIRE' lm k ;
  1234. * Usage de l'opérateur text pour éviter que lemot
  1235. * ne soit interprété comme un opérateur
  1236. 'RESPRO' 'TEXTE' lemot ;
  1237. *
  1238. * End of procedure file EXMOMOD
  1239. *
  1240. 'FINPROC' ;
  1241. *ENDPROCEDUR exmomod
  1242. *BEGINPROCEDUR formar
  1243. ************************************************************************
  1244. * NOM : FORMAR
  1245. * DESCRIPTION : formate un réel de facon courte
  1246. * pratique pour les noms de
  1247. * sauvegarde
  1248. * Exemples :
  1249. * 'MESSAGE' ('CHAINE' (formar 2.9e5 1)) ;
  1250. * 2.9E5
  1251. * 'MESSAGE' ('CHAINE' (formar -2.9e5 1)) ;
  1252. * -2.9E5
  1253. * 'MESSAGE' ('CHAINE' (formar 2.9e-5 1)) ;
  1254. * 2.9E-5
  1255. * 'MESSAGE' ('CHAINE' (formar -2.9e-5 1)) ;
  1256. * -2.9E-5
  1257. * 'MESSAGE' ('CHAINE' (formar 2.9 1)) ;
  1258. * 2.9
  1259. * 'MESSAGE' ('CHAINE' (formar -2.9 1)) ;
  1260. * -2.9
  1261. * 'MESSAGE' ('CHAINE' (formar 0 1)) ;
  1262. * 0
  1263. * 'MESSAGE' ('CHAINE' (formar 0 1)) ;
  1264. * 0
  1265. * 'MESSAGE' ('CHAINE' (formar 2.9e5 0)) ;
  1266. * 3E5
  1267. * 'MESSAGE' ('CHAINE' (formar -2.9e5 0)) ;
  1268. * -3E5
  1269. * 'MESSAGE' ('CHAINE' (formar 2.9e-5 0)) ;
  1270. * 3E-5
  1271. * 'MESSAGE' ('CHAINE' (formar -2.9e-5 0)) ;
  1272. * -3E-5
  1273. * 'MESSAGE' ('CHAINE' (formar 2.9 0)) ;
  1274. * 3
  1275. * 'MESSAGE' ('CHAINE' (formar -2.9 0)) ;
  1276. * -3
  1277. * 'MESSAGE' ('CHAINE' (formar 0 0)) ;
  1278. * 0
  1279. * 'MESSAGE' ('CHAINE' (formar 0 0)) ;
  1280. * 0
  1281. *
  1282. *
  1283. *
  1284. * LANGAGE : GIBIANE-CAST3M
  1285. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1286. * mél : gounand@semt2.smts.cea.fr
  1287. **********************************************************************
  1288. * VERSION : v1, 18/02/2003, version initiale
  1289. * HISTORIQUE : v1, 18/02/2003, création
  1290. * HISTORIQUE :
  1291. * HISTORIQUE :
  1292. ************************************************************************
  1293. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1294. * en cas de modification de ce sous-programme afin de faciliter
  1295. * la maintenance !
  1296. ************************************************************************
  1297. *
  1298. *
  1299. 'DEBPROC' FORMAR ;
  1300. 'ARGUMENT' fl*'FLOTTANT' ;
  1301. 'ARGUMENT' vir/'ENTIER ' ;
  1302. 'SI' ('NON' ('EXISTE' vir)) ;
  1303. vir = 1 ;
  1304. 'SINON' ;
  1305. 'SI' ('<' vir 0) ;
  1306. 'ERREUR' 'fournir un entier positif' ;
  1307. 'FINSI' ;
  1308. 'FINSI' ;
  1309. 'SI' ('<' ('ABS' fl) 10.D-100) ;
  1310. chfl = 'CHAINE' '0' ;
  1311. 'SINON' ;
  1312. *! sans le 1.D-10, ca ne fonctionne pas
  1313. *! qd on entre pile poil une puissance de 10
  1314. lfl = LOG10 ('ABS' fl) ;
  1315. * lfl = '+' (LOG10 ('ABS' fl)) 1.D-10 ;
  1316. slfl = 'SIGNE' ('ENTIER' lfl) ;
  1317. 'SI' ('EGA' slfl 1) ;
  1318. elfl = 'ENTIER' lfl ;
  1319. 'SINON' ;
  1320. elfl = '-' ('ENTIER' lfl) 1 ;
  1321. 'FINSI' ;
  1322. man = '/' fl ('**' 10.D0 elfl) ;
  1323. *
  1324. * Une verrue pour des histoires de précision...
  1325. *
  1326. 'SI' ('EGA' man 10.D0 ('**' 10.D0 ('*' vir -1.D0))) ;
  1327. man = '/' man 10.D0 ;
  1328. elfl = '+' elfl 1 ;
  1329. 'FINSI' ;
  1330. *
  1331. sman = 'SIGNE' man ;
  1332. 'SI' ('EGA' sman 1) ;
  1333. fman = 'CHAINE' '(F' ('+' vir 2) '.0' vir ')' ;
  1334. 'SINON' ;
  1335. fman = 'CHAINE' '(F' ('+' vir 3) '.0' vir ')' ;
  1336. 'FINSI' ;
  1337. 'SI' ('NEG' vir 0) ;
  1338. 'SI' ('NEG' elfl 0) ;
  1339. chfl = 'CHAINE' 'FORMAT' fman man 'E' elfl ;
  1340. 'SINON' ;
  1341. chfl = 'CHAINE' 'FORMAT' fman man ;
  1342. 'FINSI' ;
  1343. 'SINON' ;
  1344. man2 = 'ENTIER' ('+' man ('*' 0.5D0 sman)) ;
  1345. 'SI' ('NEG' elfl 0) ;
  1346. chfl = 'CHAINE' man2 'E' elfl ;
  1347. 'SINON' ;
  1348. chfl = 'CHAINE' man2 ;
  1349. 'FINSI' ;
  1350. 'FINSI' ;
  1351. 'FINSI' ;
  1352. 'RESPRO' chfl ;
  1353. *
  1354. * End of procedure file FORMAR
  1355. *
  1356. 'FINPROC' ;
  1357. *ENDPROCEDUR formar
  1358. *BEGINPROCEDUR gchpo
  1359. ************************************************************************
  1360. * NOM : GCHPO
  1361. * DESCRIPTION : Une matrice de masse
  1362. *
  1363. *
  1364. *
  1365. * LANGAGE : GIBIANE-CAST3M
  1366. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1367. * mél : gounand@semt2.smts.cea.fr
  1368. **********************************************************************
  1369. * VERSION : v2, 14/03/2006, mise à jour NLIN évolué
  1370. * VERSION : v1, 13/05/2004, version initiale
  1371. * HISTORIQUE : v1, 13/05/2004, création
  1372. * HISTORIQUE :
  1373. * HISTORIQUE :
  1374. ************************************************************************
  1375. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1376. * en cas de modification de ce sous-programme afin de faciliter
  1377. * la maintenance !
  1378. ************************************************************************
  1379. *
  1380. *
  1381. 'DEBPROC' GCHPO ;
  1382. 'ARGUMENT' _mt*'MAILLAGE' ;
  1383. 'ARGUMENT' nomq*'MOT ' ;
  1384. 'ARGUMENT' coef*'FLOTTANT' ;
  1385. *
  1386. 'SI' ('EGA' discq 'LINM') ;
  1387. discq = 'CSTE' ;
  1388. 'FINSI' ;
  1389. *
  1390. idim = DEADUTIL 'DIMM' _mt ;
  1391. vdim = 'VALEUR' 'DIME' ;
  1392. *
  1393. discg = TDISC . 'GEOM' . 'DISC' ;
  1394. tnomq = TDISC . nomq ;
  1395. *
  1396. ms = tnomq . 'NOMINC' . 1 ;
  1397. numop = 1 ; numder = idim ; numvar = 1 ; numdat = 0 ; numcof = 0 ;
  1398. A = ININLIN numop numvar numdat numcof numder ;
  1399. A . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
  1400. A . 'VAR' . 1 . 'DISC' = 'CSTE' ;
  1401. A . 'VAR' . 1 . 'VALEUR' = 0. ;
  1402. *
  1403. A . 1 . 1 . 0 = 'LECT' ;
  1404. *
  1405. B = ININLIN numop numvar numdat numcof numder ;
  1406. B . 'VAR' . 1 . 'NOMDDL' = ms ;
  1407. B . 'VAR' . 1 . 'DISC' = tnomq . 'DISC' ;
  1408. *
  1409. B . 1 . 1 . 0 = 'LECT' ;
  1410. *
  1411. mgchpos = '+' (NLIN discg _mt A B 'ERF1' 'GAU7') coef ;
  1412. *
  1413. mgchpo = 'NOMC' ms (tnomq . 'NOMINC' . 1) mgchpos ;
  1414. *
  1415. ninc = 'DIME' (tnomq . 'NOMINC') ;
  1416. 'SI' ('>' ninc 1) ;
  1417. 'REPETER' iinc ('-' ninc 1) ;
  1418. mgchpo = '+' mgchpo
  1419. ('NOMC' ms (tnomq . 'NOMINC' . ('+' &iinc 1)) mgchpos) ;
  1420. 'FIN' iinc ;
  1421. 'FINSI' ;
  1422. *
  1423. 'RESPRO' mgchpo ;
  1424. 'FINPROC' ;
  1425. *
  1426. * End of procedure file GCHPO
  1427. *
  1428. *ENDPROCEDUR gchpo
  1429. *BEGINPROCEDUR gdiv2
  1430. ************************************************************************
  1431. * NOM : GDIV2
  1432. * DESCRIPTION : Une matrice de masse
  1433. *
  1434. *
  1435. *
  1436. * LANGAGE : GIBIANE-CAST3M
  1437. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1438. * mél : gounand@semt2.smts.cea.fr
  1439. **********************************************************************
  1440. * VERSION : v2, 14/03/2006, mise à jour NLIN évolué
  1441. * VERSION : v1, 13/05/2004, version initiale
  1442. * HISTORIQUE : v1, 13/05/2004, création
  1443. * HISTORIQUE :
  1444. * HISTORIQUE :
  1445. ************************************************************************
  1446. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1447. * en cas de modification de ce sous-programme afin de faciliter
  1448. * la maintenance !
  1449. ************************************************************************
  1450. *
  1451. *
  1452. 'DEBPROC' GDIV2 ;
  1453. 'ARGUMENT' _mt*'MAILLAGE' ;
  1454. 'ARGUMENT' _smt/'MAILLAGE' ;
  1455. 'ARGUMENT' tdisc*'TABLE' ;
  1456. *
  1457. * Lectures
  1458. *
  1459. debug = FAUX ;
  1460. lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
  1461. 'NCOF' 'FCOF' 'CCOF' 'GBBT' 'GMBT' ;
  1462. * Il faut initialiser valt et valq, sinon on peut capturer ceux de
  1463. * la procédure appelante
  1464. valt = 'valt' ; valq = 'valq' ;
  1465. lbbt = 0 ;
  1466. *
  1467. 'REPETER' imotcle ;
  1468. 'ARGUMENT' motcle/'MOT' ;
  1469. 'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
  1470. 'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
  1471. cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
  1472. 'FINSI' ;
  1473. 'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
  1474. 'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
  1475. 'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
  1476. 'SI' ('EGA' motcle 'FPRI') ; 'ARGUMENT' valt*'LISTREEL' ; 'FINSI' ;
  1477. 'SI' ('EGA' motcle 'FDUA') ; 'ARGUMENT' valq*'FLOTTANT' ; 'FINSI' ;
  1478. 'SI' ('EGA' motcle 'FCOF') ; 'ARGUMENT' valo*'FLOTTANT' ; 'FINSI' ;
  1479. 'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
  1480. 'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
  1481. 'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
  1482. 'SI' ('EGA' motcle 'GBBT') ; lbbt = 1 ; 'FINSI' ;
  1483. 'SI' ('EGA' motcle 'GMBT') ; lbbt = 2 ; 'FINSI' ;
  1484. 'FIN' imotcle ;
  1485. *
  1486. * Tests
  1487. *
  1488. discg = TDISC . 'GEOM' . 'DISC' ;
  1489. 'SI' ('EXISTE' tdisc 'methgau') ;
  1490. methgau = tdisc . 'methgau' . 'amor' ;
  1491. 'SINON' ;
  1492. methgau = 'GAU7' ;
  1493. 'FINSI' ;
  1494. tnomt = TDISC . nomt ;
  1495. lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
  1496. tnomq = TDISC . nomq ;
  1497. lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
  1498. *
  1499. lcof = 'EXISTE' TDISC nomo ;
  1500. 'SI' lcof ; ncof = 1 ; tcof = TDISC . nomo ;
  1501. 'SINON' ; ncof = 0 ;
  1502. 'FINSI' ;
  1503. *
  1504. 'SI' debug ;
  1505. 'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
  1506. 'SINON' ; 'MESSAGE' 'pas de coef detecte' ;
  1507. 'FINSI' ;
  1508. 'FINSI' ;
  1509. *
  1510. vdim = 'VALEUR' 'DIME' ;
  1511. vmod = 'VALEUR' 'MODE' ;
  1512. idim = 0 ;
  1513. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  1514. idim = 2 ;
  1515. iaxi = FAUX ;
  1516. 'FINSI' ;
  1517. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  1518. idim = 2 ;
  1519. iaxi = VRAI ;
  1520. 'FINSI' ;
  1521. 'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  1522. idim = 3 ;
  1523. iaxi = FAUX ;
  1524. 'FINSI' ;
  1525. 'SI' ('EGA' vdim 1) ;
  1526. idim = 1 ;
  1527. iaxi = FAUX ;
  1528. 'FINSI' ;
  1529. 'SI' ('EGA' idim 0) ;
  1530. 'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  1531. 'FINSI' ;
  1532. 'SI' iaxi ;
  1533. dp = ('*' PI 2.D0) ;
  1534. rmt = 'COORDONNEE' 1 _mt ;
  1535. ncof = ncof '+' 2 ;
  1536. 'FINSI' ;
  1537. * Scalaire ou vecteur
  1538. ninct = 'DIME' (tnomt . 'NOMINC') ;
  1539. nincq = 'DIME' (tnomq . 'NOMINC') ;
  1540. 'SI' ('NEG' ninct idim) ;
  1541. cherr = 'CHAINE'
  1542. 'la primale doit etre un vecteur' ;
  1543. 'ERREUR' cherr ;
  1544. 'FINSI' ;
  1545. 'SI' ('NEG' nincq 1) ;
  1546. cherr = 'CHAINE'
  1547. 'la duale doit etre un scalaire' ;
  1548. 'ERREUR' cherr ;
  1549. 'FINSI' ;
  1550. *
  1551. numop = 1 ; numder = idim ; numvar = ninct ;
  1552. numdat = ncof ; numcof = ncof ;
  1553. A = ININLIN numop numvar numdat numcof numder ;
  1554. *
  1555. lvt = 'EGA' ('TYPE' valt) 'LISTREEL' ;
  1556. 'REPETER' iiinct ninct ;
  1557. iinct = &iiinct ;
  1558. A . 'VAR' . iinct . 'NOMDDL' = tnomt . 'NOMINC' . iinct ;
  1559. A . 'VAR' . iinct . 'DISC' = tnomt . 'DISC' ;
  1560. 'SI' lvalt ;
  1561. 'SI' lvt ;
  1562. A . 'VAR' . iinct . 'VALEUR' = 'EXTRAIRE' valt iinct ;
  1563. 'SINON' ;
  1564. A . 'VAR' . iinct . 'VALEUR' = valt ;
  1565. 'FINSI' ;
  1566. 'FINSI' ;
  1567. 'FIN' iiinct ;
  1568. *
  1569. icof = 0 ;
  1570. 'SI' lcof ;
  1571. icof = '+' icof 1 ;
  1572. A . 'DAT' . icof . 'NOMDDL' = tcof . 'NOMINC' . 1 ;
  1573. A . 'DAT' . icof . 'DISC' = tcof . 'DISC' ;
  1574. A . 'DAT' . icof . 'VALEUR' = valo ;
  1575. A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  1576. A . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  1577. ll = 'LECT' 1 ;
  1578. 'SINON' ;
  1579. ll = 'LECT' ;
  1580. 'FINSI' ;
  1581. *
  1582. 'SI' iaxi ;
  1583. icof = '+' icof 1 ;
  1584. A . 'DAT' . icof . 'NOMDDL' = 'MOTS' 'SCAL' ;
  1585. A . 'DAT' . icof . 'DISC' = 'CSTE' ;
  1586. A . 'DAT' . icof . 'VALEUR' = dp ;
  1587. A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  1588. A . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  1589. icof = '+' icof 1 ;
  1590. A . 'DAT' . icof . 'NOMDDL' = 'MOTS' 'SCAL' ;
  1591. A . 'DAT' . icof . 'DISC' = discg ;
  1592. A . 'DAT' . icof . 'VALEUR' = rmt ;
  1593. A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  1594. A . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  1595. lldpr = ll 'ET' ('LECT' ('-' icof 1) icof) ;
  1596. lldp = ll 'ET' ('LECT' ('-' icof 1)) ;
  1597. 'FINSI' ;
  1598. *
  1599. 'SI' iaxi ;
  1600. 'REPETER' iidim idim ;
  1601. A . 1 . &iidim . &iidim = lldpr ;
  1602. 'FIN' iidim ;
  1603. A . 1 . 1 . 0 = lldp ;
  1604. 'SINON' ;
  1605. 'REPETER' iidim idim ;
  1606. A . 1 . &iidim . &iidim = ll ;
  1607. 'FIN' iidim ;
  1608. 'FINSI' ;
  1609. *
  1610. numvar = 1 ;
  1611. numdat = 0 ;
  1612. numcof = 0 ;
  1613. *
  1614. B = ININLIN numop numvar numdat numcof numder ;
  1615. B . 'VAR' . 1 . 'NOMDDL' = tnomq . 'NOMINC' . 1 ;
  1616. B . 'VAR' . 1 . 'DISC' = tnomq . 'DISC' ;
  1617. 'SI' lvalq ;
  1618. B . 'VAR' . 1 . 'VALEUR' = valq ;
  1619. 'FINSI' ;
  1620. B . 1 . 1 . 0 = 'LECT' ;
  1621. *
  1622. 'SI' ('OU' ('EGA' lbbt 0) ('EGA' lbbt 1)) ;
  1623. 'SI' ('EXISTE' _smt) ;
  1624. mgdiv2 = 'NLIN' discg _mt _smt A B methgau ;
  1625. 'SINON' ;
  1626. mgdiv2 = NLINP discg _mt A B methgau ;
  1627. 'FINSI' ;
  1628. 'SI' ('EGA' lbbt 1) ;
  1629. 'SI' ('EXISTE' _smt) ;
  1630. mgdiv3 = 'NLIN' discg _mt _smt B A methgau ;
  1631. 'SINON' ;
  1632. mgdiv3 = NLINP discg _mt B A methgau ;
  1633. 'FINSI' ;
  1634. mgdiv2 = 'ET' mgdiv2 mgdiv3 ;
  1635. 'FINSI' ;
  1636. 'FINSI' ;
  1637. 'SI' ('EGA' lbbt 2) ;
  1638. 'SI' ('EXISTE' _smt) ;
  1639. mgdiv2 = 'NLIN' discg _mt _smt B A methgau ;
  1640. 'SINON' ;
  1641. mgdiv2 = NLINP discg _mt B A methgau ;
  1642. 'FINSI' ;
  1643. 'FINSI' ;
  1644. *
  1645. 'RESPRO' mgdiv2 ;
  1646. 'FINPROC' ;
  1647. *
  1648. * End of procedure file GDIV2
  1649. *
  1650. *ENDPROCEDUR gdiv2
  1651. *BEGINPROCEDUR getcoo
  1652. ************************************************************************
  1653. * NOM : GETCOO
  1654. * DESCRIPTION :
  1655. * Renvoie les coordonnées des points dans un champ type déplacement
  1656. *
  1657. *
  1658. *
  1659. * LANGAGE : GIBIANE-CAST3M
  1660. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1661. * mél : gounand@semt2.smts.cea.fr
  1662. **********************************************************************
  1663. * VERSION : v1, 22/04/2011, version initiale
  1664. * HISTORIQUE : v1, 22/04/2011, création
  1665. * HISTORIQUE :
  1666. * HISTORIQUE :
  1667. ************************************************************************
  1668. *
  1669. *
  1670. 'DEBPROC' GETCOO ;
  1671. 'ARGUMENT' mail*'MAILLAGE' ;
  1672. 'ARGUMENT' incop*'LISTMOTS' ;
  1673. *
  1674. dim = 'VALEUR' 'DIME' ;
  1675. 'REPETER' iidim dim ;
  1676. idim= &iidim ;
  1677. icoo = 'NOMC' ('EXTRAIRE' incop idim)
  1678. ('COORDONNEE' idim mail) ;
  1679. 'SI' ('EGA' idim 1) ;
  1680. vcoo = icoo ;
  1681. 'SINON' ;
  1682. vcoo = 'ET' vcoo icoo ;
  1683. 'FINSI' ;
  1684. 'FIN' iidim ;
  1685. 'RESPRO' vcoo ;
  1686. *
  1687. * End of procedure file GETCOO
  1688. *
  1689. 'FINPROC' ;
  1690. *ENDPROCEDUR getcoo
  1691. *BEGINPROCEDUR gforc
  1692. ************************************************************************
  1693. * NOM : GFORC
  1694. * DESCRIPTION : Calcul de la force associée à une pression imposée
  1695. *
  1696. *
  1697. *
  1698. * LANGAGE : GIBIANE-CAST3M
  1699. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1700. * mél : gounand@semt2.smts.cea.fr
  1701. **********************************************************************
  1702. * VERSION : v1, ??/??/2007, version initiale
  1703. * HISTORIQUE : v1, ??/??/2007, création
  1704. * HISTORIQUE :
  1705. * HISTORIQUE :
  1706. ************************************************************************
  1707. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1708. * en cas de modification de ce sous-programme afin de faciliter
  1709. * la maintenance !
  1710. ************************************************************************
  1711. *
  1712. *
  1713. 'DEBPROC' GFORC ;
  1714. 'ARGUMENT' _surf*'MAILLAGE' ;
  1715. 'ARGUMENT' tdisc*'TABLE' ;
  1716. 'ARGUMENT' pfor*'CHPOINT' ;
  1717. *
  1718. vdim = 'VALEUR' 'DIME' ;
  1719. DISCG = TDISC . 'GEOM' . 'DISC' ;
  1720. fpfor = GNOR _surf tdisc 'NPRI' discg 'CPRI' pfor 'NDUA' 'XN' ;
  1721. 'RESPRO' fpfor ;
  1722. *
  1723. * End of procedure file GFORC
  1724. *
  1725. 'FINPROC' ;
  1726. *ENDPROCEDUR gforc
  1727. *BEGINPROCEDUR ggravi
  1728. ************************************************************************
  1729. * NOM : GGRAVI
  1730. * DESCRIPTION : Calcul de la force associée au potentiel gravitaire
  1731. * (\rho g z si g vertical)
  1732. *
  1733. *
  1734. *
  1735. * LANGAGE : GIBIANE-CAST3M
  1736. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1737. * mél : gounand@semt2.smts.cea.fr
  1738. **********************************************************************
  1739. * VERSION : v1, 22/04/2011
  1740. * HISTORIQUE : v1, 22/04/2011, création
  1741. * HISTORIQUE :
  1742. * HISTORIQUE :
  1743. ************************************************************************
  1744. *
  1745. *
  1746. 'DEBPROC' GGRAVI ;
  1747. 'ARGUMENT' _surf*'MAILLAGE' ;
  1748. 'ARGUMENT' tdisc*'TABLE' ;
  1749. 'ARGUMENT' coef*'FLOTTANT' ;
  1750. 'ARGUMENT' ang*'FLOTTANT' ;
  1751. *
  1752. vdim = 'VALEUR' 'DIME' ;
  1753. pgrax = '*' ('COORDONNEE' 1 _surf) ('*' +1. ('SIN' ang)) ;
  1754. pgraz = '*' ('COORDONNEE' vdim _surf) ('*' -1. ('COS' ang)) ;
  1755. DISCG = TDISC . 'GEOM' . 'DISC' ;
  1756. fpgrax = GNOR _surf tdisc 'NPRI' discg 'CPRI' pgrax 'NDUA' 'XN' ;
  1757. fpgraz = GNOR _surf tdisc 'NPRI' discg 'CPRI' pgraz 'NDUA' 'XN' ;
  1758. fpgra = '+' fpgrax fpgraz ;
  1759. fpgra = '*' fpgra ('*' -1. coef) ;
  1760. 'RESPRO' fpgra ;
  1761. *
  1762. * End of procedure file GGRAVI
  1763. *
  1764. 'FINPROC' ;
  1765. *ENDPROCEDUR ggravi
  1766. *BEGINPROCEDUR gkforc
  1767. ************************************************************************
  1768. * NOM : GKFORC
  1769. * DESCRIPTION : Calcul de la matrice tangente associée à la force
  1770. * de pression imposée. Cette matrice tangente est
  1771. * partielle car elle ne prend en compte que le gradient
  1772. * surfacique de pression. On peut difficilement
  1773. * faire autrement si on ne considère que la surface.
  1774. *
  1775. *
  1776. * LANGAGE : GIBIANE-CAST3M
  1777. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1778. * mél : gounand@semt2.smts.cea.fr
  1779. **********************************************************************
  1780. * VERSION : v1, ??/??/2007, version initiale
  1781. * HISTORIQUE : v1, ??/??/2007, création
  1782. * HISTORIQUE :
  1783. * HISTORIQUE :
  1784. ************************************************************************
  1785. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1786. * en cas de modification de ce sous-programme afin de faciliter
  1787. * la maintenance !
  1788. ************************************************************************
  1789. *
  1790. *
  1791. 'DEBPROC' GKFORC ;
  1792. 'ARGUMENT' _surf*'MAILLAGE' ;
  1793. 'ARGUMENT' tdisc*'TABLE' ;
  1794. 'ARGUMENT' pfor*'CHPOINT' ;
  1795. 'ARGUMENT' ijaco/'ENTIER' ;
  1796. 'SI' ('NON' ('EXISTE' ijaco)) ;
  1797. ijaco = 0 ;
  1798. 'FINSI' ;
  1799. vdim = 'VALEUR' 'DIME' ;
  1800. DISCG = TDISC . 'GEOM' . 'DISC' ;
  1801. *fpfor = GNOR _surf tdisc 'NPRI' discg 'CPRI' pfor 'NDUA' 'XN' ;
  1802. k1 = GNORGC _surf tdisc 'NPRI' 'XN'
  1803. 'NCOF' discg 'CCOF' pfor
  1804. 'NDUA' 'XN' ;
  1805. * k1 = GNOR _surf tdisc 'NPRI' discg 'NDUA' 'XN' ;
  1806. * k1 = '*' k1 -1. ;
  1807. * k1 = 'CHANGER' 'INCO' k1 ('MOTS' 'SCAL')
  1808. * ('MOTS' ('EXTRAIRE' NOMVIT vdim)) NOMVIT NOMVIT ;
  1809. k2 = GNORKTAN _surf tdisc 'NPRI' 'XN'
  1810. 'NCOF' discg 'CCOF' pfor 'NDUA' 'XN' ;
  1811. 'SI' ('OU' ('EGA' ijaco 0) ('EGA' ijaco 3)) ;
  1812. ktfor = k1 'ET' k2 ;
  1813. 'FINSI' ;
  1814. 'SI' ('EGA' ijaco 1) ;
  1815. ktfor = k1 ;
  1816. 'FINSI' ;
  1817. 'SI' ('EGA' ijaco 2) ;
  1818. ktfor = k2 ;
  1819. 'FINSI' ;
  1820. ktfor = '*' ktfor -1. ;
  1821. 'RESPRO' ktfor ;
  1822. *
  1823. * End of procedure file GKFORC
  1824. *
  1825. 'FINPROC' ;
  1826. *ENDPROCEDUR gkforc
  1827. *BEGINPROCEDUR gkgravi
  1828. ************************************************************************
  1829. * NOM : GKGRAVI
  1830. * DESCRIPTION : Calcul de la matrice tangente de la force
  1831. * associée au potentiel gravitaire (calculée par GGRAVI)
  1832. * en fonction des déplacements des points de la surface.
  1833. *
  1834. *
  1835. *
  1836. * LANGAGE : GIBIANE-CAST3M
  1837. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1838. * mél : gounand@semt2.smts.cea.fr
  1839. **********************************************************************
  1840. * VERSION : v1, 22/04/2011
  1841. * HISTORIQUE : v1, 22/04/2011, création
  1842. * HISTORIQUE :
  1843. * HISTORIQUE :
  1844. ************************************************************************
  1845. *
  1846. *
  1847. 'DEBPROC' GKGRAVI ;
  1848. 'ARGUMENT' _surf*'MAILLAGE' ;
  1849. 'ARGUMENT' tdisc*'TABLE' ;
  1850. 'ARGUMENT' ijaco*'ENTIER' ;
  1851. *'SI' ('NON' ('EXISTE' ijaco)) ;
  1852. * ijaco = 0 ;
  1853. *'FINSI' ;
  1854. 'ARGUMENT' coef*'FLOTTANT' ;
  1855. 'ARGUMENT' ang*'FLOTTANT' ;
  1856. *
  1857. vdim = 'VALEUR' 'DIME' ;
  1858. pgrax = '*' ('COORDONNEE' 1 _surf) ('*' +1. ('SIN' ang)) ;
  1859. pgraz = '*' ('COORDONNEE' vdim _surf) ('*' -1. ('COS' ang)) ;
  1860. *pgra = '*' ('-' ('COORDONNEE' vdim _surf) H) -1. ;
  1861. *pgra = '*' ('COORDONNEE' vdim _surf) -1. ;
  1862. DISCG = TDISC . 'GEOM' . 'DISC' ;
  1863. NOMDEP = @STBL (TDISC . 'XN' . 'NOMINC') ;
  1864. *fpgra = GNOR _surf tdisc 'NPRI' discg 'CPRI' pgra 'NDUA' 'XN' ;
  1865. k1x = GNOR _surf tdisc 'NPRI' discg 'NDUA' 'XN' ;
  1866. k1x = '*' k1x ('*' +1. ('SIN' ang)) ;
  1867. k1x = 'CHANGER' 'INCO' k1x ('MOTS' 'SCAL')
  1868. ('MOTS' ('EXTRAIRE' NOMDEP 1)) NOMDEP NOMDEP ;
  1869. k2x = GNORKTAN _surf tdisc 'NPRI' 'XN'
  1870. 'NCOF' discg 'CCOF' pgrax 'NDUA' 'XN' ;
  1871. k1z = GNOR _surf tdisc 'NPRI' discg 'NDUA' 'XN' ;
  1872. k1z = '*' k1z ('*' -1. ('COS' ang)) ;
  1873. k1z = 'CHANGER' 'INCO' k1z ('MOTS' 'SCAL')
  1874. ('MOTS' ('EXTRAIRE' NOMDEP vdim)) NOMDEP NOMDEP ;
  1875. k2z = GNORKTAN _surf tdisc 'NPRI' 'XN'
  1876. 'NCOF' discg 'CCOF' pgraz 'NDUA' 'XN' ;
  1877. 'SI' ('EGA' ijaco 0) ;
  1878. ktgra = k1x 'ET' k1z 'ET' k2x 'ET' k2z ;
  1879. 'FINSI' ;
  1880. 'SI' ('EGA' ijaco 1) ;
  1881. ktgra = k1x 'ET' k1z ;
  1882. 'FINSI' ;
  1883. 'SI' ('EGA' ijaco 2) ;
  1884. ktgra = k2x 'ET' k2z ;
  1885. 'FINSI' ;
  1886. ktgra = '*' ktgra coef ;
  1887. 'RESPRO' ktgra ;
  1888. *
  1889. * End of procedure file GKGRAVI
  1890. *
  1891. 'FINPROC' ;
  1892. *ENDPROCEDUR gkgravi
  1893. *BEGINPROCEDUR gkvol
  1894. ************************************************************************
  1895. * NOM : GKVOL
  1896. * DESCRIPTION : Matrice tangente associée à la variation du volume
  1897. * contenu dans une surface (calculé par GVOL)
  1898. * en fonction des déplacements des points de la surface.
  1899. *
  1900. *
  1901. * LANGAGE : GIBIANE-CAST3M
  1902. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1903. * mél : gounand@semt2.smts.cea.fr
  1904. **********************************************************************
  1905. * VERSION : v1, 22/04/2011, version initiale
  1906. * HISTORIQUE : v1, 22/04/2011, création
  1907. * HISTORIQUE :
  1908. * HISTORIQUE :
  1909. ************************************************************************
  1910. *
  1911. *
  1912. 'DEBPROC' GKVOL ;
  1913. 'ARGUMENT' _surf*'MAILLAGE' ;
  1914. 'ARGUMENT' tdisc*'TABLE' ;
  1915. 'ARGUMENT' ijaco/'ENTIER' ;
  1916. 'SI' ('NON' ('EXISTE' ijaco)) ;
  1917. ijaco = 0 ;
  1918. 'FINSI' ;
  1919. * Vecteur position et calcul du volume
  1920. NOMVIT = @STBL (TDISC . 'XN' . 'NOMINC') ;
  1921. DISCG = TDISC . 'GEOM' . 'DISC' ;
  1922. vdim = 'VALEUR' 'DIME' ;
  1923. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  1924. fdim = 3 ;
  1925. 'SINON' ;
  1926. fdim = vdim ;
  1927. 'FINSI' ;
  1928. vpos = GETCOO _surf nomvit ;
  1929. kvol1 = GNOR _surf tdisc 'NPRI' ('CHAINE' discg 'V')
  1930. 'NDUA' 'XN' 'FDUA' ('PROG' vdim * 1.) ;
  1931. kvol2 = GNORKTAN _surf tdisc 'NPRI' ('CHAINE' discg 'V')
  1932. 'NCOF' ('CHAINE' discg 'V') 'CCOF' vpos
  1933. 'NDUA' 'XN' 'FDUA' ('PROG' vdim * 1.) ;
  1934. 'SI' ('EGA' ijaco 0) ;
  1935. kvol = '/' ('+' kvol1 kvol2) fdim ;
  1936. 'FINSI' ;
  1937. 'SI' ('EGA' ijaco 1) ;
  1938. kvol = '/' kvol1 fdim ;
  1939. 'FINSI' ;
  1940. 'SI' ('EGA' ijaco 2) ;
  1941. kvol = '/' kvol2 fdim ;
  1942. 'FINSI' ;
  1943. 'RESPRO' kvol ;
  1944. *
  1945. * End of procedure file GKVOL
  1946. *
  1947. 'FINPROC' ;
  1948. *ENDPROCEDUR gkvol
  1949. *BEGINPROCEDUR gmail
  1950. ************************************************************************
  1951. * NOM : GMAIL
  1952. * DESCRIPTION : Une matrice de masse
  1953. *
  1954. *
  1955. *
  1956. * LANGAGE : GIBIANE-CAST3M
  1957. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1958. * mél : gounand@semt2.smts.cea.fr
  1959. **********************************************************************
  1960. * VERSION : v2, 14/03/2006, mise à jour NLIN évolué
  1961. * VERSION : v1, 13/05/2004, version initiale
  1962. * HISTORIQUE : v1, 13/05/2004, création
  1963. * HISTORIQUE :
  1964. * HISTORIQUE :
  1965. ************************************************************************
  1966. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1967. * en cas de modification de ce sous-programme afin de faciliter
  1968. * la maintenance !
  1969. ************************************************************************
  1970. *
  1971. *
  1972. 'DEBPROC' GMAIL ;
  1973. 'ARGUMENT' _mt*'MAILLAGE' ;
  1974. 'ARGUMENT' nomq*'MOT ' ;
  1975. *
  1976. gm = GCHPO _mt nomq 1. ;
  1977. dom = 'EXTRAIRE' gm 'MAIL' ;
  1978. *
  1979. 'RESPRO' dom ;
  1980. 'FINPROC' ;
  1981. *
  1982. * End of procedure file GMAIL
  1983. *
  1984. *ENDPROCEDUR gmail
  1985. *BEGINPROCEDUR gmass2
  1986. ************************************************************************
  1987. * NOM : GMASS2
  1988. * DESCRIPTION : Une matrice de masse
  1989. *
  1990. *
  1991. *
  1992. * LANGAGE : GIBIANE-CAST3M
  1993. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1994. * mél : gounand@semt2.smts.cea.fr
  1995. **********************************************************************
  1996. * VERSION : v2, 14/03/2006, mise à jour NLIN évolué
  1997. * VERSION : v1, 13/05/2004, version initiale
  1998. * HISTORIQUE : v1, 13/05/2004, création
  1999. * HISTORIQUE :
  2000. * HISTORIQUE :
  2001. ************************************************************************
  2002. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  2003. * en cas de modification de ce sous-programme afin de faciliter
  2004. * la maintenance !
  2005. ************************************************************************
  2006. *
  2007. *
  2008. 'DEBPROC' GMASS2 ;
  2009. 'ARGUMENT' _mt*'MAILLAGE' ;
  2010. 'ARGUMENT' _smt/'MAILLAGE' ;
  2011. 'ARGUMENT' tdisc*'TABLE' ;
  2012. *
  2013. * Lectures
  2014. *
  2015. debug = FAUX ;
  2016. lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
  2017. 'NCOF' 'FCOF' 'CCOF' ;
  2018. * Il faut initialiser valt et valq, sinon on peut capturer ceux de
  2019. * la procédure appelante
  2020. valt = 'valt' ; valq = 'valq' ;
  2021. 'REPETER' imotcle ;
  2022. 'ARGUMENT' motcle/'MOT' ;
  2023. 'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
  2024. 'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
  2025. cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
  2026. 'FINSI' ;
  2027. 'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
  2028. 'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
  2029. 'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
  2030. tst1 = 'EGA' motcle 'FPRI' ; tst2 = 'EGA' motcle 'FDUA' ;
  2031. tst = tst1 'OU' tst2 ;
  2032. 'SI' tst ;
  2033. 'SI' tst1 ; tt = TDISC . nomt ; 'FINSI' ;
  2034. 'SI' tst2 ; tt = TDISC . nomq ; 'FINSI' ;
  2035. isvec = ('>' ('DIME' (tt. 'NOMINC')) 1) ;
  2036. 'SI' isvec ; 'ARGUMENT' valv*'LISTREEL' ; 'SINON' ;
  2037. 'ARGUMENT' valv*'FLOTTANT' ;
  2038. 'FINSI' ;
  2039. 'SI' tst1 ; valt = valv ; 'FINSI' ;
  2040. 'SI' tst2 ; valq = valv ; 'FINSI' ;
  2041. 'FINSI' ;
  2042. 'SI' ('EGA' motcle 'FCOF') ; 'ARGUMENT' valo*'FLOTTANT' ; 'FINSI' ;
  2043. 'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
  2044. 'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
  2045. 'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
  2046. 'FIN' imotcle ;
  2047. *
  2048. * Tests
  2049. *
  2050. discg = TDISC . 'GEOM' . 'DISC' ;
  2051. 'SI' ('EXISTE' tdisc 'methgau') ;
  2052. methgau = tdisc . 'methgau' . 'mass' ;
  2053. 'SINON' ;
  2054. methgau = 'GAU7' ;
  2055. 'FINSI' ;
  2056. tnomt = TDISC . nomt ;
  2057. lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
  2058. tnomq = TDISC . nomq ;
  2059. lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
  2060. * Scalaire ou vecteur
  2061. ninct = 'DIME' (tnomt . 'NOMINC') ;
  2062. nincq = 'DIME' (tnomq . 'NOMINC') ;
  2063. 'SI' ('NEG' ninct nincq) ;
  2064. cherr = 'CHAINE'
  2065. 'les primales et duales nont pas le meme nombre de composantes' ;
  2066. 'ERREUR' cherr ;
  2067. 'FINSI' ;
  2068. ninc = ninct ;
  2069. *
  2070. lcof = 'EXISTE' TDISC nomo ;
  2071. 'SI' lcof ; ncof = 1 ; tcof = TDISC . nomo ;
  2072. 'SINON' ; ncof = 0 ;
  2073. 'FINSI' ;
  2074. *
  2075. 'SI' debug ;
  2076. 'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
  2077. 'SINON' ; 'MESSAGE' 'pas de coef detecte' ;
  2078. 'FINSI' ;
  2079. 'FINSI' ;
  2080. *
  2081. vdim = 'VALEUR' 'DIME' ;
  2082. vmod = 'VALEUR' 'MODE' ;
  2083. idim = 0 ;
  2084. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  2085. idim = 2 ;
  2086. iaxi = FAUX ;
  2087. 'FINSI' ;
  2088. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  2089. idim = 2 ;
  2090. iaxi = VRAI ;
  2091. 'FINSI' ;
  2092. 'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  2093. idim = 3 ;
  2094. iaxi = FAUX ;
  2095. 'FINSI' ;
  2096. 'SI' ('EGA' vdim 1) ;
  2097. idim = 1 ;
  2098. iaxi = FAUX ;
  2099. 'FINSI' ;
  2100. * 'MESSAGE' ('CHAINE' 'iaxi=' iaxi );
  2101. 'SI' ('EGA' idim 0) ;
  2102. 'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  2103. 'FINSI' ;
  2104. 'SI' iaxi ;
  2105. dprmt = '*' ('COORDONNEE' 1 _mt) ('*' PI 2.D0) ;
  2106. 'FINSI' ;
  2107. *
  2108. * Optimisation possible : construire la matrice par blocs
  2109. * qd valt et valq ne sont pas donnés
  2110. *
  2111. numop = ninc ; numder = idim ; numvar = ninc ;
  2112. numdat = ncof ; numcof = ncof ;
  2113. A = ININLIN numop numvar numdat numcof numder ;
  2114. 'SI' lcof ;
  2115. A . 'DAT' . 1 . 'NOMDDL' = tcof . 'NOMINC' . 1 ;
  2116. A . 'DAT' . 1 . 'DISC' = tcof . 'DISC' ;
  2117. A . 'DAT' . 1 . 'VALEUR' = valo ;
  2118. A . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  2119. A . 'COF' . 1 . 'LDAT' = 'LECT' 1 ;
  2120. ll = 'LECT' 1 ;
  2121. 'SINON' ;
  2122. ll = 'LECT' ;
  2123. 'FINSI' ;
  2124. lvt = 'EGA' ('TYPE' valt) 'LISTREEL' ;
  2125. 'REPETER' iiinc ninc ;
  2126. iinc = &iiinc ;
  2127. A . 'VAR' . iinc . 'NOMDDL' = tnomt . 'NOMINC' . iinc ;
  2128. A . 'VAR' . iinc . 'DISC' = tnomt . 'DISC' ;
  2129. 'SI' lvalt ;
  2130. 'SI' lvt ;
  2131. A . 'VAR' . iinc . 'VALEUR' = 'EXTRAIRE' valt iinc ;
  2132. 'SINON' ;
  2133. A . 'VAR' . iinc . 'VALEUR' = valt ;
  2134. 'FINSI' ;
  2135. 'FINSI' ;
  2136. A . iinc . iinc . 0 = ll ;
  2137. 'FIN' iiinc ;
  2138. *
  2139. 'SI' iaxi ;
  2140. numdat = 1 ;
  2141. numcof = 1 ;
  2142. 'SINON' ;
  2143. numdat = 0 ;
  2144. numcof = 0 ;
  2145. 'FINSI' ;
  2146. B = ININLIN numop numvar numdat numcof numder ;
  2147. 'SI' iaxi ;
  2148. B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  2149. B . 'DAT' . 1 . 'DISC' = discg ;
  2150. B . 'DAT' . 1 . 'VALEUR' = dprmt ;
  2151. B . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  2152. B . 'COF' . 1 . 'LDAT' = 'LECT' 1 ;
  2153. ll = 'LECT' 1 ;
  2154. 'SINON' ;
  2155. ll = 'LECT' ;
  2156. 'FINSI' ;
  2157. lvq = 'EGA' ('TYPE' valq) 'LISTREEL' ;
  2158. 'REPETER' iiinc ninc ;
  2159. iinc = &iiinc ;
  2160. B . 'VAR' . iinc . 'NOMDDL' = tnomq . 'NOMINC' . iinc ;
  2161. B . 'VAR' . iinc . 'DISC' = tnomq . 'DISC' ;
  2162. 'SI' lvalq ;
  2163. 'SI' lvq ;
  2164. B . 'VAR' . iinc . 'VALEUR' = 'EXTRAIRE' valq iinc ;
  2165. 'SINON' ;
  2166. B . 'VAR' . iinc . 'VALEUR' = valq ;
  2167. 'FINSI' ;
  2168. 'FINSI' ;
  2169. B . iinc . iinc . 0 = ll ;
  2170. 'FIN' iiinc ;
  2171. *
  2172. 'SI' ('EXISTE' _smt) ;
  2173. mgmass2 = 'NLIN' discg _mt _smt A B methgau ;
  2174. 'SINON' ;
  2175. mgmass2 = NLINP discg _mt A B methgau ;
  2176. 'FINSI' ;
  2177. *
  2178. 'RESPRO' mgmass2 ;
  2179. 'FINPROC' ;
  2180. *
  2181. * End of procedure file GMASS2
  2182. *
  2183. *ENDPROCEDUR gmass2
  2184. *BEGINPROCEDUR gnorgc
  2185. ************************************************************************
  2186. * NOM : GNORGC
  2187. * DESCRIPTION : Une matrice de masse
  2188. *
  2189. *
  2190. *
  2191. * LANGAGE : GIBIANE-CAST3M
  2192. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  2193. * mél : gounand@semt2.smts.cea.fr
  2194. **********************************************************************
  2195. * VERSION : v2, 14/03/2006, mise à jour NLIN évolué
  2196. * VERSION : v1, 13/05/2004, version initiale
  2197. * HISTORIQUE : v1, 13/05/2004, création
  2198. * HISTORIQUE :
  2199. * HISTORIQUE :
  2200. ************************************************************************
  2201. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  2202. * en cas de modification de ce sous-programme afin de faciliter
  2203. * la maintenance !
  2204. ************************************************************************
  2205. *
  2206. *
  2207. 'DEBPROC' GNORGC ;
  2208. 'ARGUMENT' _mt*'MAILLAGE' ;
  2209. 'ARGUMENT' tdisc*'TABLE' ;
  2210. *
  2211. * Lectures
  2212. *
  2213. vdim = 'VALEUR' 'DIME' ;
  2214. debug = FAUX ;
  2215. lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
  2216. 'NCOF' 'FCOF' 'CCOF' ;
  2217. * Il faut initialiser valt et valq, sinon on peut capturer ceux de
  2218. * la procédure appelante
  2219. valt = 'valt' ; valq = 'valq' ;
  2220. 'REPETER' imotcle ;
  2221. 'ARGUMENT' motcle/'MOT' ;
  2222. 'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
  2223. 'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
  2224. cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
  2225. 'FINSI' ;
  2226. 'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
  2227. 'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
  2228. 'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
  2229. tst1 = 'EGA' motcle 'FPRI' ; tst2 = 'EGA' motcle 'FDUA' ;
  2230. tst3 = 'EGA' motcle 'FCOF' ;
  2231. tst = tst1 'OU' tst2 'OU' tst3 ;
  2232. 'SI' tst ;
  2233. 'SI' tst1 ; tt = TDISC . nomt ; 'FINSI' ;
  2234. 'SI' tst2 ; tt = TDISC . nomq ; 'FINSI' ;
  2235. 'SI' tst3 ; tt = TDISC . nomo ; 'FINSI' ;
  2236. isvec = ('>' ('DIME' (tt. 'NOMINC')) 1) ;
  2237. 'SI' isvec ; 'ARGUMENT' valv*'LISTREEL' ; 'SINON' ;
  2238. 'ARGUMENT' valv*'FLOTTANT' ;
  2239. 'FINSI' ;
  2240. 'SI' tst1 ; valt = valv ; 'FINSI' ;
  2241. 'SI' tst2 ; valq = valv ; 'FINSI' ;
  2242. 'SI' tst3 ; valo = valv ; 'FINSI' ;
  2243. 'FINSI' ;
  2244. 'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
  2245. 'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
  2246. 'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
  2247. 'FIN' imotcle ;
  2248. *
  2249. * Tests
  2250. *
  2251. discg = TDISC . 'GEOM' . 'DISC' ;
  2252. 'SI' ('EXISTE' tdisc 'methgau') ;
  2253. methgau = tdisc . 'methgau' . 'mass' ;
  2254. 'SINON' ;
  2255. methgau = 'GAU7' ;
  2256. 'FINSI' ;
  2257. tnomt = TDISC . nomt ;
  2258. lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
  2259. tnomq = TDISC . nomq ;
  2260. lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
  2261. * Scalaire ou vecteur
  2262. ninct = 'DIME' (tnomt . 'NOMINC') ;
  2263. nincq = 'DIME' (tnomq . 'NOMINC') ;
  2264. 'SI' ('NEG' ninct vdim) ;
  2265. cherr = 'CHAINE'
  2266. 'la primale doit etre un vecteur' ;
  2267. 'ERREUR' cherr ;
  2268. 'FINSI' ;
  2269. 'SI' ('NEG' nincq vdim) ;
  2270. cherr = 'CHAINE'
  2271. 'la duale doit etre un vecteur' ;
  2272. 'ERREUR' cherr ;
  2273. 'FINSI' ;
  2274. *ninc = ninct ;
  2275. *
  2276. lcof = 'EXISTE' TDISC nomo ;
  2277. 'SI' lcof ; tcof = TDISC . nomo ;
  2278. ncof = 'DIME' (tcof . 'NOMINC') ;
  2279. 'SINON' ; ncof = 0 ;
  2280. 'FINSI' ;
  2281. 'SI' ('NEG' ncof 1) ;
  2282. cherr = 'CHAINE'
  2283. 'il faut un coefficient scalaire' ;
  2284. 'ERREUR' cherr ;
  2285. 'FINSI' ;
  2286. *
  2287. 'SI' debug ;
  2288. 'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
  2289. 'SINON' ; 'MESSAGE' 'pas de coef detecte' ;
  2290. 'FINSI' ;
  2291. 'FINSI' ;
  2292. *
  2293. vdim = 'VALEUR' 'DIME' ;
  2294. vmod = 'VALEUR' 'MODE' ;
  2295. idim = 0 ;
  2296. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  2297. idim = 2 ;
  2298. iaxi = FAUX ;
  2299. 'FINSI' ;
  2300. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  2301. idim = 2 ;
  2302. iaxi = VRAI ;
  2303. 'FINSI' ;
  2304. 'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  2305. idim = 3 ;
  2306. iaxi = FAUX ;
  2307. 'FINSI' ;
  2308. 'SI' ('EGA' vdim 1) ;
  2309. idim = 1 ;
  2310. iaxi = FAUX ;
  2311. 'FINSI' ;
  2312. * 'MESSAGE' ('CHAINE' 'iaxi=' iaxi );
  2313. 'SI' ('EGA' idim 0) ;
  2314. 'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  2315. 'FINSI' ;
  2316. 'SI' iaxi ;
  2317. dprmt = '*' ('COORDONNEE' 1 _mt) ('*' PI 2.D0) ;
  2318. 'FINSI' ;
  2319. *
  2320. * Optimisation possible : construire la matrice par blocs
  2321. * qd valt et valq ne sont pas donnés
  2322. *
  2323. numop = ninct '*' nincq ; numder = idim ; numvar = ninct ;
  2324. numdat = 1 ; numcof = idim ;
  2325. A = ININLIN numop numvar numdat numcof numder ;
  2326. A . 'DAT' . 1 . 'NOMDDL' = tcof . 'NOMINC' . 1 ;
  2327. A . 'DAT' . 1 . 'DISC' = tcof . 'DISC' ;
  2328. A . 'DAT' . 1 . 'VALEUR' = valo ;
  2329. 'REPETER' iicof numcof ;
  2330. icof = &iicof ;
  2331. A . 'COF' . icof . 'COMPOR' = 'CHAINE' 'D/DX' icof ;
  2332. A . 'COF' . icof . 'LDAT' = 'LECT' 1 ;
  2333. 'FIN' iicof ;
  2334. lvt = 'EGA' ('TYPE' valt) 'LISTREEL' ;
  2335. iop = 0 ;
  2336. 'REPETER' iiinct ninct ;
  2337. iinct = &iiinct ;
  2338. A . 'VAR' . iinct . 'NOMDDL' = tnomt . 'NOMINC' . iinct ;
  2339. A . 'VAR' . iinct . 'DISC' = tnomt . 'DISC' ;
  2340. 'SI' lvalt ;
  2341. 'SI' lvt ;
  2342. A . 'VAR' . iinct . 'VALEUR' = 'EXTRAIRE' valt iinct ;
  2343. 'SINON' ;
  2344. A . 'VAR' . iinct . 'VALEUR' = valt ;
  2345. 'FINSI' ;
  2346. 'FINSI' ;
  2347. ll = 'LECT' iinct ;
  2348. 'REPETER' iiincq nincq ;
  2349. iop = '+' iop 1 ;
  2350. A . iop . iinct . 0 = 'LECT' ;
  2351. * A . iop . iinct . 0 = ll ;
  2352. 'FIN' iiincq ;
  2353. 'FIN' iiinct ;
  2354. *
  2355. 'SI' iaxi ;
  2356. numdat = 1 ;
  2357. numcof = idim '+' 1 ;
  2358. 'SINON' ;
  2359. numdat = 0 ;
  2360. numcof = idim ;
  2361. 'FINSI' ;
  2362. numvar = nincq ;
  2363. B = ININLIN numop numvar numdat numcof numder ;
  2364. icof = 0 ;
  2365. 'REPETER' iiidim idim ;
  2366. icof = '+' icof 1 ;
  2367. B . 'COF' . icof . 'COMPOR' = 'CHAINE' 'VNOR' &iiidim ;
  2368. B . 'COF' . icof . 'LDAT' = 'LECT' ;
  2369. 'FIN' iiidim ;
  2370. *
  2371. 'SI' iaxi ;
  2372. icof = '+' icof 1 ;
  2373. B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  2374. B . 'DAT' . 1 . 'DISC' = discg ;
  2375. B . 'DAT' . 1 . 'VALEUR' = dprmt ;
  2376. B . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  2377. B . 'COF' . icof . 'LDAT' = 'LECT' 1 ;
  2378. ll = 'LECT' icof ;
  2379. 'SINON' ;
  2380. ll = 'LECT' ;
  2381. 'FINSI' ;
  2382. lvq = 'EGA' ('TYPE' valq) 'LISTREEL' ;
  2383. 'REPETER' iiincq nincq ;
  2384. iincq = &iiincq ;
  2385. B . 'VAR' . iincq . 'NOMDDL' = tnomq . 'NOMINC' . iincq ;
  2386. B . 'VAR' . iincq . 'DISC' = tnomq . 'DISC' ;
  2387. 'SI' lvalq ;
  2388. 'SI' lvq ;
  2389. B . 'VAR' . iincq . 'VALEUR' = 'EXTRAIRE' valq iincq ;
  2390. 'SINON' ;
  2391. B . 'VAR' . iincq . 'VALEUR' = valq ;
  2392. 'FINSI' ;
  2393. 'FINSI' ;
  2394. 'FIN' iiincq ;
  2395. iop = 0 ;
  2396. 'REPETER' iiinct ninct ;
  2397. * iinct = &iiinct ;
  2398. 'REPETER' iiincq nincq ;
  2399. iincq = &iiincq ;
  2400. iop = '+' iop 1 ;
  2401. B . iop . iincq . 0 = ('LECT' iincq) 'ET' ll ;
  2402. 'FIN' iiincq ;
  2403. 'FIN' iiinct ;
  2404. *
  2405. mgnorgc = NLIN discg _mt A B methgau ;
  2406. *
  2407. 'RESPRO' mgnorgc ;
  2408. 'FINPROC' ;
  2409. *
  2410. * End of procedure file GNORGC
  2411. *
  2412. *ENDPROCEDUR gnorgc
  2413. *BEGINPROCEDUR gnorktan
  2414. ************************************************************************
  2415. * NOM : GNORKTAN
  2416. * DESCRIPTION : Matrice tangente associée à la variation de la normale
  2417. * à une surface (calculée par GNOR)
  2418. * en fonction des déplacements des points de la surface.
  2419. *
  2420. *
  2421. *
  2422. * LANGAGE : GIBIANE-CAST3M
  2423. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  2424. * mél : gounand@semt2.smts.cea.fr
  2425. **********************************************************************
  2426. * VERSION : v1, 22/04/2011, version initiale
  2427. * HISTORIQUE : v1, 22/04/2011, création
  2428. * HISTORIQUE :
  2429. * HISTORIQUE :
  2430. ************************************************************************
  2431. *
  2432. *
  2433. 'DEBPROC' GNORKTAN ;
  2434. 'ARGUMENT' _mt*'MAILLAGE' ;
  2435. 'ARGUMENT' tdisc*'TABLE' ;
  2436. *
  2437. * Lectures
  2438. *
  2439. dim = 'VALEUR' 'DIME' ;
  2440. mdim = DEADUTIL 'DIMM' _mt ;
  2441. 'SI' ('NEG' mdim ('-' dim 1)) ;
  2442. 'ERREUR' 'Dim. maillage .neq. dim. espace - 1' ;
  2443. 'FINSI' ;
  2444. loi = 'CHAINE' 'VNOJ' ;
  2445. debug = FAUX ;
  2446. lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
  2447. 'NCOF' 'FCOF' 'CCOF' ;
  2448. * Il faut initialiser valt et valq, sinon on peut capturer ceux de
  2449. * la procédure appelante
  2450. valt = 'valt' ; valq = 'valq' ;
  2451. 'REPETER' imotcle ;
  2452. 'ARGUMENT' motcle/'MOT' ;
  2453. 'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
  2454. 'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
  2455. cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
  2456. 'FINSI' ;
  2457. 'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
  2458. 'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
  2459. 'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
  2460. tst1 = 'EGA' motcle 'FPRI' ; tst2 = 'EGA' motcle 'FDUA' ;
  2461. tst = tst1 'OU' tst2 ;
  2462. 'SI' tst ;
  2463. 'SI' tst1 ; tt = TDISC . nomt ; 'FINSI' ;
  2464. 'SI' tst2 ; tt = TDISC . nomq ; 'FINSI' ;
  2465. isvec = ('>' ('DIME' (tt. 'NOMINC')) 1) ;
  2466. 'SI' isvec ; 'ARGUMENT' valv*'LISTREEL' ; 'SINON' ;
  2467. 'ARGUMENT' valv*'FLOTTANT' ;
  2468. 'FINSI' ;
  2469. 'SI' tst1 ; valt = valv ; 'FINSI' ;
  2470. 'SI' tst2 ; valq = valv ; 'FINSI' ;
  2471. 'FINSI' ;
  2472. 'SI' ('EGA' motcle 'FCOF') ; 'ARGUMENT' valo*'FLOTTANT' ; 'FINSI' ;
  2473. 'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
  2474. 'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
  2475. 'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
  2476. 'FIN' imotcle ;
  2477. *
  2478. * Tests
  2479. *
  2480. discg = TDISC . 'GEOM' . 'DISC' ;
  2481. 'SI' ('EXISTE' tdisc 'methgau') ;
  2482. methgau = tdisc . 'methgau' . 'mass' ;
  2483. 'SINON' ;
  2484. methgau = 'GAU7' ;
  2485. 'FINSI' ;
  2486. tnomt = TDISC . nomt ;
  2487. lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
  2488. tnomq = TDISC . nomq ;
  2489. lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
  2490. * Scalaire ou vecteur
  2491. ninct = 'DIME' (tnomt . 'NOMINC') ;
  2492. nincq = 'DIME' (tnomq . 'NOMINC') ;
  2493. 'SI' ('NEG' ninct dim) ;
  2494. cherr = 'CHAINE'
  2495. 'la primale doit etre un vecteur' ;
  2496. 'ERREUR' cherr ;
  2497. 'FINSI' ;
  2498. 'SI' ('NEG' nincq dim) ;
  2499. cherr = 'CHAINE'
  2500. 'la duale doit etre un vecteur' ;
  2501. 'ERREUR' cherr ;
  2502. 'FINSI' ;
  2503. ninc = dim ;
  2504. *
  2505. lcof = 'EXISTE' TDISC nomo ;
  2506. 'SI' lcof ; tcof = TDISC . nomo ;
  2507. ncof = 'DIME' (tcof . 'NOMINC') ;
  2508. 'SINON' ; ncof = 0 ;
  2509. 'FINSI' ;
  2510. *
  2511. 'SI' debug ;
  2512. 'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
  2513. 'SINON' ; 'MESSAGE' 'pas de coef detecte' ;
  2514. 'FINSI' ;
  2515. 'FINSI' ;
  2516. *
  2517. vdim = 'VALEUR' 'DIME' ;
  2518. vmod = 'VALEUR' 'MODE' ;
  2519. idim = 0 ;
  2520. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  2521. idim = 2 ;
  2522. iaxi = FAUX ;
  2523. 'FINSI' ;
  2524. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  2525. idim = 2 ;
  2526. iaxi = VRAI ;
  2527. 'FINSI' ;
  2528. 'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  2529. idim = 3 ;
  2530. iaxi = FAUX ;
  2531. 'FINSI' ;
  2532. 'SI' ('EGA' vdim 1) ;
  2533. idim = 1 ;
  2534. iaxi = FAUX ;
  2535. 'FINSI' ;
  2536. * 'MESSAGE' ('CHAINE' 'iaxi=' iaxi );
  2537. 'SI' ('EGA' idim 0) ;
  2538. 'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  2539. 'FINSI' ;
  2540. 'SI' iaxi ;
  2541. deupi = '*' PI 2.D0 ;
  2542. dprmt = '*' ('COORDONNEE' 1 _mt) deupi ;
  2543. 'FINSI' ;
  2544. *
  2545. * Optimisation possible : construire la matrice par blocs
  2546. * qd valt et valq ne sont pas donnés
  2547. *
  2548. numop = idim '*' idim '*' idim ;
  2549. 'SI' iaxi ;
  2550. numop = numop '+' idim ;
  2551. 'FINSI' ;
  2552. numder = idim ; numvar = ninct ;
  2553. numdat = ncof ; numcof = ncof ;
  2554. A = ININLIN numop numvar numdat numcof numder ;
  2555. 'SI' lcof ;
  2556. lvo = 'EGA' ('TYPE' valo) 'LISTREEL' ;
  2557. 'REPETER' iicof ncof ;
  2558. icof = &iicof ;
  2559. A . 'DAT' . icof . 'NOMDDL' = tcof . 'NOMINC' . icof ;
  2560. A . 'DAT' . icof . 'DISC' = tcof . 'DISC' ;
  2561. 'SI' lvo ;
  2562. A . 'DAT' . icof . 'VALEUR' = 'EXTRAIRE' valo icof ;
  2563. 'SINON' ;
  2564. A . 'DAT' . icof . 'VALEUR' = valo ;
  2565. 'FINSI' ;
  2566. A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  2567. A . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  2568. 'FIN' iicof ;
  2569. 'SINON' ;
  2570. ll = 'LECT' ;
  2571. 'FINSI' ;
  2572. lvt = 'EGA' ('TYPE' valt) 'LISTREEL' ;
  2573. iop = 0 ;
  2574. 'REPETER' iiinct ninct ;
  2575. iinct = &iiinct ;
  2576. A . 'VAR' . iinct . 'NOMDDL' = tnomt . 'NOMINC' . iinct ;
  2577. A . 'VAR' . iinct . 'DISC' = tnomt . 'DISC' ;
  2578. 'SI' lvalt ;
  2579. 'SI' lvt ;
  2580. A . 'VAR' . iinct . 'VALEUR' = 'EXTRAIRE' valt iinct ;
  2581. 'SINON' ;
  2582. A . 'VAR' . iinct . 'VALEUR' = valt ;
  2583. 'FINSI' ;
  2584. 'FINSI' ;
  2585. 'REPETER' iiincq nincq ;
  2586. 'REPETER' iiider numder ;
  2587. iop = '+' iop 1 ;
  2588. 'SI' lcof ;
  2589. icof = 'MINIMUM' ('LECT' &iiincq ncof) ;
  2590. A . iop . iinct . &iiider = 'LECT' icof ;
  2591. 'SINON' ;
  2592. A . iop . iinct . &iiider = ll ;
  2593. 'FINSI' ;
  2594. 'FIN' iiider ;
  2595. 'FIN' iiincq ;
  2596. 'FIN' iiinct ;
  2597. 'SI' iaxi ;
  2598. 'REPETER' iiincq nincq ;
  2599. iop = '+' iop 1 ;
  2600. 'SI' lcof ;
  2601. icof = 'MINIMUM' ('LECT' &iiincq ncof) ;
  2602. A . iop . 1 . 0 = 'LECT' icof ;
  2603. 'SINON' ;
  2604. A . iop . 1 . 0 = ll ;
  2605. 'FINSI' ;
  2606. 'FIN' iiincq ;
  2607. 'FINSI' ;
  2608. *
  2609. * 'SI' iaxi ;
  2610. * numdat = 1 ;
  2611. * numcof = dim '+' 1 ;
  2612. * 'SINON' ;
  2613. numdat = 0 ;
  2614. numcof = idim '*' idim '*' idim ;
  2615. * 'FINSI' ;
  2616. 'SI' iaxi ;
  2617. numdat = '+' numdat 2 ;
  2618. numcof = '+' numcof ('+' idim 2) ;
  2619. 'FINSI' ;
  2620. numvar = nincq ;
  2621. B = ININLIN numop numvar numdat numcof numder ;
  2622. *
  2623. lvq = 'EGA' ('TYPE' valq) 'LISTREEL' ;
  2624. 'REPETER' iiinc nincq ;
  2625. iinc = &iiinc ;
  2626. B . 'VAR' . iinc . 'NOMDDL' = tnomq . 'NOMINC' . iinc ;
  2627. B . 'VAR' . iinc . 'DISC' = tnomq . 'DISC' ;
  2628. 'SI' lvalq ;
  2629. 'SI' lvq ;
  2630. B . 'VAR' . iinc . 'VALEUR' = 'EXTRAIRE' valq iinc ;
  2631. 'SINON' ;
  2632. B . 'VAR' . iinc . 'VALEUR' = valq ;
  2633. 'FINSI' ;
  2634. 'FINSI' ;
  2635. 'FIN' iiinc ;
  2636. idat = 0 ;
  2637. icof = 0 ;
  2638. 'SI' iaxi ;
  2639. 'REPETER' iiidim idim ;
  2640. icof = '+' icof 1 ;
  2641. B . 'COF' . icof . 'COMPOR' = 'CHAINE' 'VNOR' &iiidim ;
  2642. B . 'COF' . icof . 'LDAT' = 'LECT' ;
  2643. 'FIN' iiidim ;
  2644. idat = '+' idat 1 ;
  2645. icof = '+' icof 1 ;
  2646. B . 'DAT' . idat . 'NOMDDL' = 'MOTS' 'SCAL' ;
  2647. B . 'DAT' . idat . 'DISC' = discg ;
  2648. B . 'DAT' . idat . 'VALEUR' = dprmt ;
  2649. B . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  2650. B . 'COF' . icof . 'LDAT' = 'LECT' idat ;
  2651. ll = 'LECT' icof ;
  2652. idat = '+' idat 1 ;
  2653. icof = '+' icof 1 ;
  2654. B . 'DAT' . idat . 'NOMDDL' = 'MOTS' 'SCAL' ;
  2655. B . 'DAT' . idat . 'DISC' = 'CSTE' ;
  2656. B . 'DAT' . idat . 'VALEUR' = deupi ;
  2657. B . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  2658. B . 'COF' . icof . 'LDAT' = 'LECT' idat ;
  2659. ll2 = 'LECT' icof ;
  2660. 'SINON' ;
  2661. ll = 'LECT' ;
  2662. 'FINSI' ;
  2663. *
  2664. iop = 0 ;
  2665. 'REPETER' iiinct ninct ;
  2666. 'REPETER' iiincq nincq ;
  2667. 'REPETER' iiider numder ;
  2668. iop = '+' iop 1 ;
  2669. icof = '+' icof 1 ;
  2670. lcomp = 'CHAINE' loi &iiincq &iiinct &iiider ;
  2671. * lcomp = 'CHAINE' loi &iiinct &iiincq &iiider ;
  2672. B . 'COF' . icof . 'COMPOR' = lcomp ;
  2673. B . 'COF' . icof . 'LDAT' = 'LECT' ;
  2674. B . iop . &iiincq . 0 = ('LECT' icof) 'ET' ll ;
  2675. 'FIN' iiider ;
  2676. 'FIN' iiincq ;
  2677. 'FIN' iiinct ;
  2678. 'SI' iaxi ;
  2679. 'REPETER' iiincq nincq ;
  2680. iincq = &iiincq ;
  2681. iop = '+' iop 1 ;
  2682. B . iop . iincq . 0 = ('LECT' iincq) 'ET' ll2 ;
  2683. 'FIN' iiincq ;
  2684. 'FINSI' ;
  2685. *
  2686. * mgnorkt = NLIN discg _mt A B 'CRES' methgau ;
  2687. mgnorkt = NLIN discg _mt A B methgau ;
  2688. *
  2689. 'RESPRO' mgnorkt ;
  2690. 'FINPROC' ;
  2691. *
  2692. * End of procedure file GNORKTAN
  2693. *
  2694. *ENDPROCEDUR gnorktan
  2695. *BEGINPROCEDUR gnor
  2696. ************************************************************************
  2697. * NOM : GNOR
  2698. * DESCRIPTION : Calcule le champ de normales à une surface.
  2699. * Peut servir à calculer une pression, un potentiel
  2700. * lié à la gravité, un volume contenu dans une surface.
  2701. * Attention à l'orientation de la surface !
  2702. *
  2703. * Computes a field of normal to a surface.
  2704. * Also useful to compute a pressure field,
  2705. * a gravity potential field, a volume enclosed
  2706. * by a surface.
  2707. * WARNING : The orientation of the surface matters !
  2708. *
  2709. *
  2710. *
  2711. *
  2712. * LANGAGE : GIBIANE-CAST3M
  2713. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  2714. * mél : gounand@semt2.smts.cea.fr
  2715. **********************************************************************
  2716. * VERSION : v1, 22/04/2011
  2717. * HISTORIQUE : v1, 22/04/2011, création
  2718. * HISTORIQUE :
  2719. * HISTORIQUE :
  2720. ************************************************************************
  2721. *
  2722. *
  2723. 'DEBPROC' GNOR ;
  2724. 'ARGUMENT' _mt*'MAILLAGE' ;
  2725. 'ARGUMENT' tdisc*'TABLE' ;
  2726. *
  2727. * Lectures
  2728. *
  2729. dim = 'VALEUR' 'DIME' ;
  2730. debug = FAUX ;
  2731. lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
  2732. 'NCOF' 'FCOF' 'CCOF' ;
  2733. * Il faut initialiser valt et valq, sinon on peut capturer ceux de
  2734. * la procédure appelante
  2735. valt = 'valt' ; valq = 'valq' ;
  2736. 'REPETER' imotcle ;
  2737. 'ARGUMENT' motcle/'MOT' ;
  2738. 'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
  2739. 'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
  2740. cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
  2741. 'FINSI' ;
  2742. 'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
  2743. 'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
  2744. 'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
  2745. tst1 = 'EGA' motcle 'FPRI' ; tst2 = 'EGA' motcle 'FDUA' ;
  2746. tst3 = 'EGA' motcle 'FCOF' ;
  2747. tst = tst1 'OU' tst2 'OU' tst3 ;
  2748. 'SI' tst ;
  2749. 'SI' tst1 ; tt = TDISC . nomt ; 'FINSI' ;
  2750. 'SI' tst2 ; tt = TDISC . nomq ; 'FINSI' ;
  2751. 'SI' tst3 ; tt = TDISC . nomo ; 'FINSI' ;
  2752. isvec = ('>' ('DIME' (tt. 'NOMINC')) 1) ;
  2753. 'SI' isvec ; 'ARGUMENT' valv*'LISTREEL' ; 'SINON' ;
  2754. 'ARGUMENT' valv*'FLOTTANT' ;
  2755. 'FINSI' ;
  2756. 'SI' tst1 ; valt = valv ; 'FINSI' ;
  2757. 'SI' tst2 ; valq = valv ; 'FINSI' ;
  2758. 'SI' tst3 ; valo = valv ; 'FINSI' ;
  2759. 'FINSI' ;
  2760. 'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
  2761. 'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
  2762. 'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
  2763. 'FIN' imotcle ;
  2764. *
  2765. * Tests
  2766. *
  2767. discg = TDISC . 'GEOM' . 'DISC' ;
  2768. 'SI' ('EXISTE' tdisc 'methgau') ;
  2769. methgau = tdisc . 'methgau' . 'mass' ;
  2770. 'SINON' ;
  2771. methgau = 'GAU7' ;
  2772. 'FINSI' ;
  2773. tnomt = TDISC . nomt ;
  2774. lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
  2775. tnomq = TDISC . nomq ;
  2776. lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
  2777. * Scalaire ou vecteur
  2778. ninct = 'DIME' (tnomt . 'NOMINC') ;
  2779. nincq = 'DIME' (tnomq . 'NOMINC') ;
  2780. 'SI' ('ET' ('NEG' ninct 1) ('NEG' ninct dim)) ;
  2781. cherr = 'CHAINE'
  2782. 'la primale doit etre un scalaire ou un vecteur' ;
  2783. 'ERREUR' cherr ;
  2784. 'FINSI' ;
  2785. 'SI' ('NEG' nincq dim) ;
  2786. cherr = 'CHAINE'
  2787. 'la duale doit etre un vecteur' ;
  2788. 'ERREUR' cherr ;
  2789. 'FINSI' ;
  2790. *ninc = ninct ;
  2791. *
  2792. lcof = 'EXISTE' TDISC nomo ;
  2793. 'SI' lcof ; tcof = TDISC . nomo ;
  2794. ncof = 'DIME' (tcof . 'NOMINC') ;
  2795. 'SINON' ; ncof = 0 ;
  2796. 'FINSI' ;
  2797. *
  2798. 'SI' debug ;
  2799. 'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
  2800. 'SINON' ; 'MESSAGE' 'pas de coef detecte' ;
  2801. 'FINSI' ;
  2802. 'FINSI' ;
  2803. *
  2804. vdim = 'VALEUR' 'DIME' ;
  2805. vmod = 'VALEUR' 'MODE' ;
  2806. idim = 0 ;
  2807. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  2808. idim = 2 ;
  2809. iaxi = FAUX ;
  2810. 'FINSI' ;
  2811. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  2812. idim = 2 ;
  2813. iaxi = VRAI ;
  2814. 'FINSI' ;
  2815. 'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  2816. idim = 3 ;
  2817. iaxi = FAUX ;
  2818. 'FINSI' ;
  2819. 'SI' ('EGA' vdim 1) ;
  2820. idim = 1 ;
  2821. iaxi = FAUX ;
  2822. 'FINSI' ;
  2823. * 'MESSAGE' ('CHAINE' 'iaxi=' iaxi );
  2824. 'SI' ('EGA' idim 0) ;
  2825. 'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  2826. 'FINSI' ;
  2827. 'SI' iaxi ;
  2828. dprmt = '*' ('COORDONNEE' 1 _mt) ('*' PI 2.D0) ;
  2829. 'FINSI' ;
  2830. *
  2831. * Optimisation possible : construire la matrice par blocs
  2832. * qd valt et valq ne sont pas donnés
  2833. *
  2834. numop = nincq ; numder = idim ; numvar = ninct ;
  2835. numdat = ncof ; numcof = ncof ;
  2836. A = ININLIN numop numvar numdat numcof numder ;
  2837. 'SI' lcof ;
  2838. lvo = 'EGA' ('TYPE' valo) 'LISTREEL' ;
  2839. 'REPETER' iicof ncof ;
  2840. icof = &iicof ;
  2841. A . 'DAT' . icof . 'NOMDDL' = tcof . 'NOMINC' . icof ;
  2842. A . 'DAT' . icof . 'DISC' = tcof . 'DISC' ;
  2843. 'SI' lvo ;
  2844. A . 'DAT' . icof . 'VALEUR' = 'EXTRAIRE' valo icof ;
  2845. 'SINON' ;
  2846. A . 'DAT' . icof . 'VALEUR' = valo ;
  2847. 'FINSI' ;
  2848. A . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  2849. A . 'COF' . icof . 'LDAT' = 'LECT' icof ;
  2850. 'FIN' iicof ;
  2851. 'SINON' ;
  2852. ll = 'LECT' ;
  2853. 'FINSI' ;
  2854. lvt = 'EGA' ('TYPE' valt) 'LISTREEL' ;
  2855. 'REPETER' iiincq nincq ;
  2856. iincq = &iiincq ;
  2857. iinct = 'MINIMUM' ('LECT' iincq ninct) ;
  2858. A . 'VAR' . iinct . 'NOMDDL' = tnomt . 'NOMINC' . iinct ;
  2859. A . 'VAR' . iinct . 'DISC' = tnomt . 'DISC' ;
  2860. 'SI' lvalt ;
  2861. 'SI' lvt ;
  2862. A . 'VAR' . iinct . 'VALEUR' = 'EXTRAIRE' valt iinct ;
  2863. 'SINON' ;
  2864. A . 'VAR' . iinct . 'VALEUR' = valt ;
  2865. 'FINSI' ;
  2866. 'FINSI' ;
  2867. 'SI' lcof ;
  2868. icof = 'MINIMUM' ('LECT' iincq ncof) ;
  2869. A . iincq . iinct . 0 = 'LECT' icof ;
  2870. 'SINON' ;
  2871. A . iincq . iinct . 0 = ll ;
  2872. 'FINSI' ;
  2873. 'FIN' iiincq ;
  2874. *
  2875. 'SI' iaxi ;
  2876. numdat = 1 ;
  2877. numcof = dim '+' 1 ;
  2878. 'SINON' ;
  2879. numdat = 0 ;
  2880. numcof = dim ;
  2881. 'FINSI' ;
  2882. numvar = nincq ;
  2883. B = ININLIN numop numvar numdat numcof numder ;
  2884. icof = 0 ;
  2885. 'REPETER' iiidim idim ;
  2886. icof = '+' icof 1 ;
  2887. B . 'COF' . icof . 'COMPOR' = 'CHAINE' 'VNOR' &iiidim ;
  2888. B . 'COF' . icof . 'LDAT' = 'LECT' ;
  2889. 'FIN' iiidim ;
  2890. *
  2891. 'SI' iaxi ;
  2892. icof = '+' icof 1 ;
  2893. B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  2894. B . 'DAT' . 1 . 'DISC' = discg ;
  2895. B . 'DAT' . 1 . 'VALEUR' = dprmt ;
  2896. B . 'COF' . icof . 'COMPOR' = 'IDEN' ;
  2897. B . 'COF' . icof . 'LDAT' = 'LECT' 1 ;
  2898. ll = 'LECT' icof ;
  2899. 'SINON' ;
  2900. ll = 'LECT' ;
  2901. 'FINSI' ;
  2902. lvq = 'EGA' ('TYPE' valq) 'LISTREEL' ;
  2903. 'REPETER' iiincq nincq ;
  2904. iincq = &iiincq ;
  2905. B . 'VAR' . iincq . 'NOMDDL' = tnomq . 'NOMINC' . iincq ;
  2906. B . 'VAR' . iincq . 'DISC' = tnomq . 'DISC' ;
  2907. 'SI' lvalq ;
  2908. 'SI' lvq ;
  2909. B . 'VAR' . iincq . 'VALEUR' = 'EXTRAIRE' valq iincq ;
  2910. 'SINON' ;
  2911. B . 'VAR' . iincq . 'VALEUR' = valq ;
  2912. 'FINSI' ;
  2913. 'FINSI' ;
  2914. B . iincq . iincq . 0 = ('LECT' iincq) 'ET' ll ;
  2915. 'FIN' iiincq ;
  2916. *
  2917. mgnor = NLIN discg _mt A B methgau ;
  2918. *
  2919. 'RESPRO' mgnor ;
  2920. 'FINPROC' ;
  2921. *
  2922. * End of procedure file GNOR
  2923. *
  2924. *ENDPROCEDUR gnor
  2925. *BEGINPROCEDUR grig
  2926. ************************************************************************
  2927. * NOM : GRIG
  2928. * DESCRIPTION :
  2929. *
  2930. *
  2931. *
  2932. * LANGAGE : GIBIANE-CAST3M
  2933. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  2934. * mél : gounand@semt2.smts.cea.fr
  2935. **********************************************************************
  2936. * VERSION : v1, ??/??/2007, version initiale
  2937. * HISTORIQUE : v1, ??/??/2007, création
  2938. * HISTORIQUE :
  2939. * HISTORIQUE :
  2940. ************************************************************************
  2941. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  2942. * en cas de modification de ce sous-programme afin de faciliter
  2943. * la maintenance !
  2944. ************************************************************************
  2945. *
  2946. *
  2947. 'DEBPROC' GRIG ;
  2948. 'ARGUMENT' _mt*'MAILLAGE' ;
  2949. 'ARGUMENT' tdisc*'TABLE' ;
  2950. *
  2951. * Lectures
  2952. *
  2953. debug = FAUX ;
  2954. lmotcle = 'MOTS' 'NPRI' 'FPRI' 'CPRI' 'NDUA' 'FDUA' 'CDUA'
  2955. 'NCOF' 'FCOF' 'CCOF' 'LAPN' 'GMBT' ;
  2956. * Il faut initialiser valt et valq, sinon on peut capturer ceux de
  2957. * la procédure appelante
  2958. valt = 'valt' ; valq = 'valq' ;
  2959. llapn = 0 ;
  2960. 'REPETER' imotcle ;
  2961. 'ARGUMENT' motcle/'MOT' ;
  2962. 'SI' ('NON' ('EXISTE' motcle)) ; 'QUITTER' imotcle ; 'FINSI' ;
  2963. 'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
  2964. cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 'ERREUR' cherr ;
  2965. 'FINSI' ;
  2966. 'SI' ('EGA' motcle 'NPRI') ; 'ARGUMENT' nomt*'MOT' ; 'FINSI' ;
  2967. 'SI' ('EGA' motcle 'NDUA') ; 'ARGUMENT' nomq*'MOT' ; 'FINSI' ;
  2968. 'SI' ('EGA' motcle 'NCOF') ; 'ARGUMENT' nomo*'MOT' ; 'FINSI' ;
  2969. tst1 = 'EGA' motcle 'FPRI' ; tst2 = 'EGA' motcle 'FDUA' ;
  2970. tst = tst1 'OU' tst2 ;
  2971. 'SI' tst ;
  2972. 'SI' tst1 ; tt = TDISC . nomt ; 'FINSI' ;
  2973. 'SI' tst2 ; tt = TDISC . nomq ; 'FINSI' ;
  2974. isvec = ('>' ('DIME' (tt. 'NOMINC')) 1) ;
  2975. 'SI' isvec ; 'ARGUMENT' valv*'LISTREEL' ; 'SINON' ;
  2976. 'ARGUMENT' valv*'FLOTTANT' ;
  2977. 'FINSI' ;
  2978. 'SI' tst1 ; valt = valv ; 'FINSI' ;
  2979. 'SI' tst2 ; valq = valv ; 'FINSI' ;
  2980. 'FINSI' ;
  2981. 'SI' ('EGA' motcle 'FCOF') ; 'ARGUMENT' valo*'FLOTTANT' ; 'FINSI' ;
  2982. 'SI' ('EGA' motcle 'CPRI') ; 'ARGUMENT' valt*'CHPOINT' ; 'FINSI' ;
  2983. 'SI' ('EGA' motcle 'CDUA') ; 'ARGUMENT' valq*'CHPOINT' ; 'FINSI' ;
  2984. 'SI' ('EGA' motcle 'CCOF') ; 'ARGUMENT' valo*'CHPOINT' ; 'FINSI' ;
  2985. 'SI' ('EGA' motcle 'LAPN') ; llapn = 1 ; 'FINSI' ;
  2986. 'SI' ('EGA' motcle 'GMBT') ; llapn = 2 ; 'FINSI' ;
  2987. 'FIN' imotcle ;
  2988. *
  2989. * Tests
  2990. *
  2991. discg = TDISC . 'GEOM' . 'DISC' ;
  2992. 'SI' ('EXISTE' tdisc 'methgau') ;
  2993. methgau = tdisc . 'methgau' . 'rigi' ;
  2994. 'SINON' ;
  2995. methgau = 'GAU7' ;
  2996. 'FINSI' ;
  2997. tnomt = TDISC . nomt ;
  2998. lvalt = 'NEG' ('TYPE' valt) 'MOT' ;
  2999. tnomq = TDISC . nomq ;
  3000. lvalq = 'NEG' ('TYPE' valq) 'MOT' ;
  3001. * Scalaire ou vecteur
  3002. ninct = 'DIME' (tnomt . 'NOMINC') ;
  3003. nincq = 'DIME' (tnomq . 'NOMINC') ;
  3004. 'SI' ('NEG' ninct nincq) ;
  3005. cherr = 'CHAINE'
  3006. 'les primales et duales nont pas le meme nombre de composantes' ;
  3007. 'ERREUR' cherr ;
  3008. 'FINSI' ;
  3009. 'SI' ('NEG' ninct ('VALEUR' 'DIME')) ;
  3010. cherr = 'CHAINE'
  3011. 'les inconnues doivent etre vectorielles' ;
  3012. 'ERREUR' cherr ;
  3013. 'FINSI' ;
  3014. *
  3015. ninc = ninct ;
  3016. *
  3017. lcof = 'EXISTE' TDISC nomo ;
  3018. 'SI' lcof ; ncof = 1 ; tcof = TDISC . nomo ;
  3019. 'SINON' ; ncof = 0 ;
  3020. 'FINSI' ;
  3021. *
  3022. 'SI' debug ;
  3023. 'SI' lcof ; 'MESSAGE' 'Un coef a ete detecte' ;
  3024. 'SINON' ; 'MESSAGE' 'pas de coef detecte' ;
  3025. 'FINSI' ;
  3026. 'FINSI' ;
  3027. *
  3028. vdim = 'VALEUR' 'DIME' ;
  3029. vmod = 'VALEUR' 'MODE' ;
  3030. idim = 0 ;