Télécharger defila2.dgibi

Retour à la liste

Numérotation des lignes :

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