Télécharger la plaquette Cast3M


fr en

Télécharger defila.dgibi

Retour à la liste

Numérotation des lignes : 

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

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