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