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

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