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

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