Télécharger la plaquette Cast3M


fr en

Télécharger trainee_2d.dgibi

Retour à la liste

Numérotation des lignes : 

  1. * fichier : trainee_2d.dgibi
  2. 'OPTION' 'ECHO' 0 ;
  3. *BEGINPROCEDUR calcul
  4. ************************************************************************
  5. * NOM         : CALCUL
  6. * DESCRIPTION :
  7. *
  8. *
  9. *
  10. * LANGAGE     : GIBIANE-CAST3M
  11. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  12. *               mél : gounand@semt2.smts.cea.fr
  13. **********************************************************************
  14. * VERSION    : v1, 10/10/2006, version initiale
  15. * HISTORIQUE : v1, 10/10/2006, création
  16. * HISTORIQUE :
  17. * HISTORIQUE :
  18. ************************************************************************
  19. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  20. * en cas de modification de ce sous-programme afin de faciliter
  21. * la maintenance !
  22. ************************************************************************
  23. *
  24. *
  25. 'DEBPROC' CALCUL ;
  26. 'ARGUMENT' tymesh*'ENTIER' ;
  27. 'ARGUMENT' irig*'ENTIER' ;
  28. 'ARGUMENT' iden*'FLOTTANT' ;
  29. 'ARGUMENT' debug/'LOGIQUE' ;
  30. *
  31. 'SI' ('NON' ('EXISTE' debug)) ;
  32.    debug = FAUX ;
  33. 'FINSI' ;
  34. *
  35. 'DENS' iden ;
  36. *
  37. tabgeo = CMAIL Ar Az discg tymesh ;
  38. _mt = tabgeo . 'mt' . 'QUAF' ;
  39. titgeo = 'CHAINE' 'mt ' 'NBPO=' ('NBNO' _mt)
  40.                      ' NBELEM=' ('NBEL' _mt) ;
  41. 'SI' debug ;                     
  42.    'TRACER' _mt 'TITRE' titgeo ;
  43. 'FINSI' ;   
  44. *
  45. * Solution exacte
  46. *
  47. mvit = tabgeo . 'mt' . discv ;
  48. mvitq = tabgeo . 'mt' . 'QUAF' ;
  49. cmvit = 'CONTOUR' (tabgeo . 'mt' . 'QUAI') ;
  50. solx = SOLEX mvit ;
  51. vsolx = 'VECTEUR' solx 'DEPL' 'JAUN' ;
  52. *'TRACER' vsolx mvit ;
  53. *
  54. * Conditions aux limites
  55. *
  56. mur  = (tabgeo . 'cmt' . discv) ;
  57. muz  =   (tabgeo . 'sph' . discv) 'ET' (tabgeo . 'bot' . discv)
  58.     'ET' (tabgeo . 'inf' . discv) 'ET' (tabgeo . 'top' . discv) ;
  59. ppres  = 'POIN'  (tabgeo . 'bot' . discv)
  60.                  'PROC' (('*' Ar 0.5) ('*' Az -1.)) ;
  61. *lpres  = 'ELEM' mvclim 'APPUYE' 'LARGEMENT' ppres ;                 
  62. *mvclim = 'DIFF' mvclim lpres ;
  63. lpres  = 'MANUEL' 'POI1' ppres ;
  64. muz    = 'DIFF' ('CHANGER' muz 'POI1') lpres ;
  65. 'SI' debug ;
  66.    'TRACER' muz 'TITR' 'Maillage clim' ;
  67. 'FINSI' ;   
  68. cclim  = '+' ('REDU' ('EXCO' 'UR' solx 'UR') mur)
  69.              ('REDU' ('EXCO' 'UZ' solx 'UZ') muz) ;
  70. mblo   = 'ET' ('BLOQUE' 'UR' mur) ('BLOQUE' 'UZ' muz) ;
  71. fblo   = 'DEPIMPOSE' mblo cclim ;
  72. *
  73. * Matrice de rigidité
  74. *
  75. mrig = GRIG _mt discg discv lvip lvid 1. ;
  76. 'SI' ('EGA' irig 1) ;
  77.    mrigt = mrig ;
  78. 'FINSI' ;
  79. 'SI' ('EGA' irig 2) ;
  80.    mrig2 = GRIG2 _mt discg discv lvip lvid 1. ;
  81.    mrigt = mrig 'ET' mrig2 ;
  82. 'FINSI' ;
  83. 'SI' ('EGA' irig 3) ;   
  84.    mrig3 = GRIG3 _mt discg discv lvip lvid 1. ;
  85.    mrigt = mrig 'ET' mrig3 ;
  86. 'FINSI' ;   
  87. *
  88. * Matrice de contrainte div u = 0
  89. *
  90. mbbt = GBBT2 _mt discg discv lvip lvid discp lpip lpid 1. ;
  91. *
  92. mtot = ('*' mrigt -1.) 'ET' mblo 'ET' ('*' mbbt -1.) ;
  93. ftot = fblo ;
  94. sola = 'KRES' mtot ftot ;
  95. dsol = 'EXCO' lvip ('-' sola solx) ;
  96. *
  97. * Post-traitement
  98. *
  99. 'SI' debug ;
  100.    vsola = 'VECTEUR' sola 'DEPL' 'ROUG' ;
  101.    vdsol = 'VECTEUR' dsol 'DEPL' 'JAUN' ;
  102.    'TRACER' (vsolx 'ET' vsola) mvitq  ;
  103. 'FINSI' ;   
  104. *'TRACER' vdsol mvitq  ;
  105. *
  106. * Erreur L2 avec poids entre vitesse approchée
  107. * et interpolé de la vitesse exacte
  108. *
  109. mmass = GMASS _mt discg 'SCAL' discv 'SCAL' discv 1. ;
  110. ms = 'MOTS' 'SCAL' ;
  111. mur = 'EXTRAIRE' lvip ('LECT' 1) ;
  112. mfr = 'EXTRAIRE' lvid ('LECT' 1) ;
  113. muz = 'EXTRAIRE' lvip ('LECT' 2) ;
  114. mfz = 'EXTRAIRE' lvid ('LECT' 2) ;
  115. mmasr = 'CHANGER' 'INCO' mmass ms mur ms mfr ;
  116. mmasz = 'CHANGER' 'INCO' mmass ms muz ms mfz ;
  117. mmas = mmasr 'ET' mmasz ;
  118. dsol = 'EXCO' lvip ('-' sola solx) ;
  119. errl2 = '**' (xtmx dsol mmas) 0.5D0 ;
  120. errli = 'MAXIMUM' dsol 'ABS' ;
  121. *
  122. * Force de traînée de Stokes
  123. *
  124. ft = 'REAC' mblo sola ;
  125. fts = 'REDU' ft (tabgeo . 'sph' . discv) ;
  126. rft = 'RESULT' fts ;
  127. fstox = '*' PI 6.D0 ;
  128. fstoa = 'MAXIMUM' ('EXCO' 'FZ' rft) 'ABS' ;
  129. errfst = '/' ('ABS' ('-' fstox fstoa)) fstox ;
  130. *
  131. 'SI' debug ;
  132.    'MESSAGE' ('CHAINE' 'Résultante de la force de trainee =' fstoa) ;
  133. *   'LISTE' rft ;
  134.    'MESSAGE' ('CHAINE' 'Force de Stokes = ' fstox) ;
  135.    'MESSAGE' ('CHAINE' 'Err rel. trainee  = ' errfst) ;
  136.    'MESSAGE' ('CHAINE' 'Erreur L2 = ' errl2) ;
  137.    'MESSAGE' ('CHAINE' 'Maxi sola - solex = ' errli) ;
  138. 'FINSI' ;   
  139. *
  140. 'RESPRO' errl2 errli errfst ;
  141. *
  142. * End of procedure file CALCUL
  143. *
  144. 'FINPROC' ;
  145. *ENDPROCEDUR calcul
  146. *BEGINPROCEDUR cmail
  147. ************************************************************************
  148. * NOM         : CMAIL
  149. * DESCRIPTION : Maillages pour le cas-test Stokes
  150. *
  151. *
  152. *
  153. * LANGAGE     : GIBIANE-CAST3M
  154. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  155. *               mél : gounand@semt2.smts.cea.fr
  156. **********************************************************************
  157. * VERSION    : v1, 11/04/2006, version initiale
  158. * HISTORIQUE : v1, 11/04/2006, création
  159. * HISTORIQUE :
  160. * HISTORIQUE :
  161. ************************************************************************
  162. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  163. * en cas de modification de ce sous-programme afin de faciliter
  164. * la maintenance !
  165. ************************************************************************
  166. *
  167. *
  168. 'DEBPROC' CMAIL ;
  169. 'ARGUMENT' Ar*'FLOTTANT' ;
  170. 'ARGUMENT' Az*'FLOTTANT' ;
  171. 'ARGUMENT' discg*'MOT' ;
  172. 'ARGUMENT' tymesh*'ENTIER' ;
  173. *
  174. 'SI' ('EGA' tymesh 1) ;
  175.    ell = 'TRI3' ; elq = 'TRI6' ;
  176. 'FINSI' ;   
  177. 'SI' ('OU' ('EGA' tymesh 2) ('EGA' tymesh 3)) ;
  178.    ell = 'QUA4' ; elq = 'QUA8' ;
  179. 'FINSI' ;   
  180. disq = 'OU' ('EGA' discg 'QUAF') ('EGA' discg 'QUAD') ;
  181. 'OPTION' 'ELEM' elq ;
  182. *
  183. * Points
  184. *
  185. pA = 0. ('*' Az -1.) ; pB = Ar  ('*' Az -1.) ;
  186. pC = Ar      Az      ; pD = 0.       Az      ;
  187. pE = 0. 1. ; pF = 1. 0. ; pG = 0. -1. ;
  188. p0 = 0. 0. ;
  189. * Lignes
  190. 'SI' ('OU' ('EGA' tymesh 1) ('EGA' tymesh 3)) ;
  191.    bot = 'DROIT' pA pB ; inf = 'DROIT' pB pC ;
  192.    top = 'DROIT' pC pD ;
  193.     axt = 'DROIT' pD pE ;
  194.     'SI' ('NON' disq) ;
  195.       'OPTION' 'ELEM' ell ;
  196.       sph = 'CER3' pE pF pG ;
  197.       sph = 'CHANGER' sph 'QUADRATIQUE' ;
  198.       'OPTION' 'ELEM' elq ;
  199.    'SINON' ;   
  200.       sph = 'CER3' pE pF pG ;
  201.    'FINSI' ;
  202.    axb = 'DROIT' pG pA ;
  203.    axe = axt 'ET' axb ;
  204.    cmt = bot 'ET' inf 'ET' top 'ET' axt 'ET' sph 'ET' axb ;
  205. * Surface
  206.    mt = 'SURFACE' cmt ;
  207. 'FINSI' ;
  208. 'SI' ('EGA' tymesh 2) ;
  209.    'SI' ('NON' disq) ;
  210.       'OPTION' 'ELEM' ell ;
  211.       bot = 'DROIT' pA pB ; inf = 'DROIT' pB pC ;
  212.       top = 'DROIT' pC pD ;
  213.       ext = bot 'ET' inf 'ET' top ;
  214.       sph = 'PROJETER' ext 'CONI' p0 'CERC' p0 pF ; 
  215. *      'TRACER' sph 'TITRE' 'Lineaire' 'NOEU' ;
  216.       sph = 'CHANGER' sph 'QUADRATIQUE' ;
  217.       bot = 'CHANGER' bot 'QUADRATIQUE' ;
  218.       top = 'CHANGER' top 'QUADRATIQUE' ;
  219.       inf = 'CHANGER' inf 'QUADRATIQUE' ;
  220.       ext = bot 'ET' inf 'ET' top ;
  221. *      'TRACER' sph 'TITRE' 'Quadratique' 'NOEU' ;
  222.       'OPTION' 'ELEM' elq ;
  223.    'SINON' ;   
  224.       bot = 'DROIT' pA pB ; inf = 'DROIT' pB pC ;
  225.       top = 'DROIT' pC pD ;
  226.       ext = bot 'ET' inf 'ET' top ;
  227.       sph = 'PROJETER' ext 'CONI' p0 'CERC' p0 pF ; 
  228.    'FINSI' ;
  229. * Surface
  230.    'OPTION' 'ELEM' elq ;
  231.    mt = 'REGLER' sph ext ;
  232.    sph = 'INVERSE' sph ;
  233.    cmt = 'CONTOUR' mt ;
  234.    axe = 'DIFF' cmt (ext 'ET' sph) ;
  235. 'FINSI' ;
  236. _mt = 'CHANGER' mt 'QUAF' ;
  237. *
  238. tabgeo = 'TABLE' ;
  239. tabgeo . 'mt' = 'TABLE' ;
  240. tabgeo . 'mt' . 'QUAF' = _mt ;
  241. q9 = 'NEG' (ISINLIS 'QUA9' ('ELEM' _mt 'TYPE')) 0 ;
  242. t6 = 'NEG' (ISINLIS 'TRI6' ('ELEM' mt 'TYPE')) 0 ;
  243. 'SI' ('ET' q9 t6) ;
  244.    tabgeo . 'mt' . 'QUAD' = 'ET' ('ELEM' _mt 'QUA9')
  245.                                  ('ELEM' mt 'TRI6') ;
  246. 'SINON' ;
  247.    'SI' t6 ;
  248.       tabgeo . 'mt' . 'QUAD' = mt ;
  249.    'FINSI' ;
  250.    'SI' q9 ;
  251.       tabgeo . 'mt' . 'QUAD' = _mt ;
  252.    'FINSI' ;
  253. 'FINSI' ;         
  254. tabgeo . 'mt' . 'QUAI' = mt ;
  255. tabgeo . 'mt' . 'LINM' = 'DOMA'
  256.   ('MODELISER' _mt 'NAVIER_STOKES' 'QUAF') 'CENTRE' ;
  257. tabgeo . 'mt' . 'LINE' = 'CHANGER' mt 'LINEAIRE' ;
  258. tabgeo . 'mt' . 'LINC' =  'DOMA'
  259.   ('MODELISER' _mt 'NAVIER_STOKES' 'QUAF') 'FACE' ;
  260. tabgeo . 'mt' . 'CSTE' = tabgeo . 'mt' . 'LINM' ;
  261. tabgeo . 'bot' = 'TABLE' ;
  262. tabgeo . 'bot' . 'QUAF' = bot ;
  263. tabgeo . 'bot' . 'QUAD' = bot ;
  264. tabgeo . 'bot' . 'QUAI' = bot ;
  265. tabgeo . 'bot' . 'LINE' = 'CHANGER' bot 'LINEAIRE' ;
  266. tabgeo . 'bot' . 'LINC' =  'DOMA'
  267.   ('MODELISER' bot 'NAVIER_STOKES' 'QUAF') 'CENTRE' ;
  268. tabgeo . 'inf' = 'TABLE' ;
  269. tabgeo . 'inf' . 'QUAF' = inf ;
  270. tabgeo . 'inf' . 'QUAD' = inf ;
  271. tabgeo . 'inf' . 'QUAI' = inf ;
  272. tabgeo . 'inf' . 'LINE' = 'CHANGER' inf 'LINEAIRE' ;
  273. tabgeo . 'inf' . 'LINC' =  'DOMA'
  274.   ('MODELISER' inf 'NAVIER_STOKES' 'QUAF') 'CENTRE' ;
  275. tabgeo . 'top' = 'TABLE' ;
  276. tabgeo . 'top' . 'QUAF' = top ;
  277. tabgeo . 'top' . 'QUAD' = top ;
  278. tabgeo . 'top' . 'QUAI' = top ;
  279. tabgeo . 'top' . 'LINE' = 'CHANGER' top 'LINEAIRE' ;
  280. tabgeo . 'top' . 'LINC' =  'DOMA'
  281.   ('MODELISER' top 'NAVIER_STOKES' 'QUAF') 'CENTRE' ;
  282. tabgeo . 'axe' = 'TABLE' ;
  283. tabgeo . 'axe' . 'QUAF' = axe ;
  284. tabgeo . 'axe' . 'QUAD' = axe ;
  285. tabgeo . 'axe' . 'QUAI' = axe ;
  286. tabgeo . 'axe' . 'LINE' = 'CHANGER' axe 'LINEAIRE' ;
  287. tabgeo . 'axe' . 'LINC' =  'DOMA'
  288.   ('MODELISER' axe 'NAVIER_STOKES' 'QUAF') 'CENTRE' ;
  289. tabgeo . 'sph' = 'TABLE' ;
  290. tabgeo . 'sph' . 'QUAF' = sph ;
  291. tabgeo . 'sph' . 'QUAD' = sph ;
  292. tabgeo . 'sph' . 'QUAI' = sph ;
  293. tabgeo . 'sph' . 'LINE' = 'CHANGER' sph 'LINEAIRE' ;
  294. tabgeo . 'sph' . 'LINC' =  'DOMA'
  295.   ('MODELISER' sph 'NAVIER_STOKES' 'QUAF') 'CENTRE' ;
  296. tabgeo . 'cmt' = 'TABLE' ;
  297. tabgeo . 'cmt' . 'QUAF' = cmt ;
  298. tabgeo . 'cmt' . 'QUAD' = cmt ;
  299. tabgeo . 'cmt' . 'QUAI' = cmt ;
  300. tabgeo . 'cmt' . 'LINE' = 'CHANGER' cmt 'LINEAIRE' ;
  301. tabgeo . 'cmt' . 'LINC' =  'DOMA'
  302.   ('MODELISER' cmt 'NAVIER_STOKES' 'QUAF') 'CENTRE' ;
  303. 'RESPRO' tabgeo ;
  304. *
  305. * End of procedure file CMAIL
  306. *
  307. 'FINPROC' ;
  308. *ENDPROCEDUR cmail
  309. *BEGINPROCEDUR solex
  310. ************************************************************************
  311. * NOM         : SOLEX
  312. * DESCRIPTION : Solution exacte de l'équation de Stokes 
  313. *
  314. *
  315. *
  316. * LANGAGE     : GIBIANE-CAST3M
  317. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  318. *               mél : gounand@semt2.smts.cea.fr
  319. **********************************************************************
  320. * VERSION    : v1, 04/10/2006, version initiale
  321. * HISTORIQUE : v1, 04/10/2006, création
  322. * HISTORIQUE :
  323. * HISTORIQUE :
  324. ************************************************************************
  325. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  326. * en cas de modification de ce sous-programme afin de faciliter
  327. * la maintenance !
  328. ************************************************************************
  329. *
  330. *
  331. 'DEBPROC' SOLEX ;
  332. 'ARGUMENT' mail*'MAILLAGE' ;
  333. vdim = 'VALEUR' 'DIME' ;
  334. vmod = 'VALEUR' 'MODE' ;
  335. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  336.    rho z = 'COORDONNEE' mail ;
  337.    r = '**' ('+' ('**' rho 2) ('**' z 2)) 0.5 ;
  338.    cphi = '/' z r ;
  339.    sphi = '/' rho r ;
  340.    unsr = 'INVERSE' r ;
  341.    unsr3 = '**' unsr 3 ;
  342.    vrho = cphi '*' sphi '*' ('-' ('*' unsr 0.75) ('*' unsr3 0.75)) ;
  343.    vz   = '+' ('*' ('**' cphi 2) ('-' ('*' unsr 1.5) ('*' unsr3 0.5)))
  344.            ('*' ('**' sphi 2) ('+' ('*' unsr 0.75) ('*' unsr3 0.25))) ;
  345.    solv = '+' ('NOMC' 'UR' vrho) ('NOMC' 'UZ' vz) ;
  346. 'FINSI' ;
  347. 'SI' ('EGA' vdim 3) ;
  348.    x y z = 'COORDONNEE' mail ;
  349.    r2    = ('**' x 2) '+' ('**' y 2) '+' ('**' z 2) ;
  350.    rho2  = ('**' x 2) '+' ('**' y 2) ;
  351.    r     = '**' r2 0.5 ;
  352.    unsr = 'INVERSE' r ;
  353.    unsr2 = 'INVERSE' r2 ;
  354.    unsr3 = '**' unsr 3 ;
  355.    alpha = '-' ('*' unsr 1.5) ('*' unsr3 0.5) ;
  356.    beta  = '+' ('*' unsr 0.75) ('*' unsr3 0.25) ;
  357.    amb   = '-' alpha beta ;
  358.    vx    = amb '*' x '*' z '*' unsr2 ;
  359.    vy    = amb '*' y '*' z '*' unsr2 ;
  360.    vz    = ('+' (alpha '*' z '*' z)
  361.                 (beta  '*' rho2)) '*' unsr2 ;
  362.    solv = ('NOMC' 'UX' vx) '+' ('NOMC' 'UY' vy) '+' ('NOMC' 'UZ' vz) ;
  363. 'FINSI' ;
  364. 'RESPRO' solv ;
  365. *
  366. * End of procedure file SOLEX
  367. *
  368. 'FINPROC' ;
  369. *ENDPROCEDUR solex
  370. *BEGINPROCEDUR gmass
  371. ************************************************************************
  372. * NOM         : GMASS
  373. * DESCRIPTION : Une matrice de masse
  374. *
  375. *
  376. *
  377. * LANGAGE     : GIBIANE-CAST3M
  378. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  379. *               mél : gounand@semt2.smts.cea.fr
  380. **********************************************************************
  381. * VERSION    : v2, 14/03/2006, mise à jour NLIN évolué
  382. * VERSION    : v1, 13/05/2004, version initiale
  383. * HISTORIQUE : v1, 13/05/2004, création
  384. * HISTORIQUE :
  385. * HISTORIQUE :
  386. ************************************************************************
  387. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  388. * en cas de modification de ce sous-programme afin de faciliter
  389. * la maintenance !
  390. ************************************************************************
  391. *
  392. *
  393. 'DEBPROC' GMASS ;
  394. 'ARGUMENT'     _mt*'MAILLAGE' ;
  395. 'ARGUMENT'     _smt/'MAILLAGE' ;
  396. 'ARGUMENT'   gdisc*'MOT     ' ;
  397. 'ARGUMENT'    nomt*'MOT     ' ;
  398. 'ARGUMENT'   disct*'MOT     ' ;
  399. 'ARGUMENT'    nomq*'MOT     ' ;
  400. 'ARGUMENT'   discq*'MOT     ' ;
  401. 'ARGUMENT' coef/'FLOTTANT' ;
  402.    'SI' ('NON' ('EXISTE' coef)) ;
  403.       'ARGUMENT' coef2/'CHPOINT ' ;
  404.       'SI' ('NON' ('EXISTE' coef2)) ;
  405.          'ERREUR' 'Il faut donner un coef FLOTTANT ou CHPOINT' ;
  406.       'SINON' ;
  407.          coef = coef2 ;
  408.          'ARGUMENT' discc*'MOT     ' ;
  409.       'FINSI' ;                  
  410.    'SINON' ;
  411.       discc = 'CSTE' ;
  412.    'FINSI' ;
  413. 'ARGUMENT' methgau/'MOT     ' ;
  414.    'SI' ('NON' ('EXISTE' methgau)) ;
  415.       methgau = 'GAU7' ;
  416.    'FINSI' ;
  417. 'ARGUMENT' chpop/'CHPOINT' ;
  418. 'ARGUMENT' chpod/'CHPOINT' ;
  419. *
  420.    vdim = 'VALEUR' 'DIME' ;
  421.    vmod = 'VALEUR' 'MODE' ;
  422.    idim = 0 ;
  423.    'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  424.       idim = 2 ;
  425.       iaxi = FAUX ;
  426.    'FINSI' ;
  427.    'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  428.       idim = 2 ;
  429.       iaxi = VRAI ;
  430.    'FINSI' ;
  431.    'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  432.       idim = 3 ;
  433.       iaxi = FAUX ;
  434.    'FINSI' ;
  435.    'SI' ('EGA' vdim 1) ;
  436.       idim = 1 ;
  437.       iaxi = FAUX ;
  438.    'FINSI' ;
  439.    'SI' ('EGA' idim 0) ;
  440.       'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  441.    'FINSI' ;
  442.    'SI' iaxi ;
  443.       dprmt = '*' ('COORDONNEE' 1 _mt) ('*' PI 2.D0) ;
  444.    'FINSI' ;      
  445.    numop  = 1 ;
  446.    numder = idim ;
  447.    mmt = 'MOTS' nomt ;
  448.    mmq = 'MOTS' nomq ;
  449.    numvar = 1 ;
  450.    numdat = 1 ;
  451.    numcof = 1 ;
  452. *
  453.    A = ININLIN numop numvar numdat numcof numder ;   
  454.    A . 'VAR' . 1 . 'NOMDDL' = mmt ;
  455.    A . 'VAR' . 1 . 'DISC'   = disct ;
  456.    'SI' ('EXISTE' chpop) ;
  457.       A . 'VAR' . 1 . 'VALEUR'   = chpop ;
  458.    'FINSI' ;   
  459.    A . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  460.    A . 'DAT' . 1 . 'DISC'   = discc ;
  461.    A . 'DAT' . 1 . 'VALEUR' = coef ;
  462.    A . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  463.    A . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
  464. *
  465.    A . 1 . 1 . 0 = 'LECT' 1 ;
  466. *
  467.    'SI' iaxi ;
  468.       numdat = 1 ;
  469.       numcof = 1 ;
  470.    'SINON' ;      
  471.       numdat = 0 ;
  472.       numcof = 0 ;
  473.    'FINSI' ;      
  474.    B = ININLIN numop numvar numdat numcof numder ;   
  475.    B . 'VAR' . 1 . 'NOMDDL' = mmq ;
  476.    B . 'VAR' . 1 . 'DISC'   = discq ;
  477.    'SI' ('EXISTE' chpod) ;
  478.       B . 'VAR' . 1 . 'VALEUR'   = chpod ;
  479.    'FINSI' ;   
  480. *
  481.    'SI' iaxi ;
  482.       B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  483.       B . 'DAT' . 1 . 'DISC'   = gdisc ;
  484.       B . 'DAT' . 1 . 'VALEUR' = dprmt ;
  485.       B . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  486.       B . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
  487.    'FINSI' ;
  488.    'SI' iaxi ;      
  489.       B . 1 . 1 . 0 = 'LECT' 1 ;
  490.    'SINON' ;      
  491.       B . 1 . 1 . 0 = 'LECT' ;
  492.    'FINSI' ;      
  493. *
  494.    'SI' ('EXISTE' _smt) ;
  495.        mgmass = 'NLIN' gdisc _mt _smt A B methgau ;
  496.    'SINON' ;       
  497.        mgmass = 'NLIN' gdisc _mt A B methgau ;
  498.    'FINSI' ;       
  499. *
  500. 'RESPRO' mgmass ;
  501. 'FINPROC' ;
  502. *
  503. * End of procedure file GMASS
  504. *
  505. *ENDPROCEDUR gmass
  506. *BEGINPROCEDUR grig
  507. ************************************************************************
  508. * NOM         : GRIG
  509. * DESCRIPTION : Matrice de rigidité axisymétrique 
  510. *               sous forme (gradu . gradv)
  511. *
  512. *
  513. * LANGAGE     : GIBIANE-CAST3M
  514. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  515. *               mél : gounand@semt2.smts.cea.fr
  516. **********************************************************************
  517. * VERSION    : v1, 13/05/2004, version initiale
  518. * HISTORIQUE : v1, 13/05/2004, création
  519. * HISTORIQUE :
  520. * HISTORIQUE :
  521. ************************************************************************
  522. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  523. * en cas de modification de ce sous-programme afin de faciliter
  524. * la maintenance !
  525. ************************************************************************
  526. *
  527. *
  528. 'DEBPROC' GRIG ;
  529. 'ARGUMENT'     _mt*'MAILLAGE' ;
  530. 'ARGUMENT'   gdisc*'MOT     ' ;
  531. 'ARGUMENT'   discv*'MOT     ' ;
  532. 'ARGUMENT'   lvp*'LISTMOTS' ;
  533. 'ARGUMENT'   lvd*'LISTMOTS' ;
  534. 'ARGUMENT' coef/'FLOTTANT' ;
  535. 'SI' ('NON' ('EXISTE' coef)) ;
  536.    'ARGUMENT' coef2/'CHPOINT ' ;
  537.    'SI' ('NON' ('EXISTE' coef2)) ;
  538.       'ERREUR' 'Il faut donner un coef FLOTTANT ou CHPOINT' ;
  539.    'SINON' ;
  540.       coef = coef2 ;
  541.       'ARGUMENT' discc*'MOT     ' ;
  542.    'FINSI' ;                  
  543. 'SINON' ;
  544.    discc = 'CSTE' ;
  545. 'FINSI' ;            
  546. 'ARGUMENT' methgau/'MOT     ' ;
  547. 'SI' ('NON' ('EXISTE' methgau)) ;
  548.     methgau = 'GAU7' ;
  549. 'FINSI' ;      
  550. 'ARGUMENT' chpop/'CHPOINT' ;
  551. 'ARGUMENT' chpod/'CHPOINT' ;
  552. *
  553.    vdim = 'VALEUR' 'DIME' ;
  554.    vmod = 'VALEUR' 'MODE' ;
  555.    idim = 0 ;
  556.    'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  557.       idim = 2 ;
  558.       iaxi = FAUX ;
  559.    'FINSI' ;
  560.    'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  561.       idim = 2 ;
  562.       iaxi = VRAI ;
  563.    'FINSI' ;
  564.    'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  565.       idim = 3 ;
  566.       iaxi = FAUX ;
  567.    'FINSI' ;
  568.    'SI' ('EGA' vdim 1) ;
  569.       idim = 1 ;
  570.       iaxi = FAUX ;
  571.    'FINSI' ;
  572.    'SI' ('EGA' idim 0) ;
  573.       'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  574.    'FINSI' ;
  575.    'SI' iaxi ;
  576.       rmt = 'COORDONNEE' 1 _mt ;
  577.       deupi = ('*' PI 2.D0) ;
  578.    'FINSI' ;      
  579. * Test bête...
  580.    'SI' ('EGA' ('TYPE' coef) 'CHPOINT ') ;
  581.       mincoef = 'MINIMUM' coef ;
  582.    'SINON' ;
  583.       mincoef = coef ;
  584.    'FINSI' ;            
  585.    'SI' ('<' mincoef 0.D0) ;
  586.       'ERREUR' 'Le coef (une viscosité) doit etre positive' ;
  587.    'FINSI' ;      
  588. *
  589. 'SI' iaxi ;
  590.    numop  = 5 ;
  591.    numder = idim ;
  592.    numvar = 2 ;
  593.    numdat = 2 ;
  594.    numcof = 2 ;
  595. *
  596.    A = ININLIN numop numvar numdat numcof numder ;
  597.    'REPETER' iidim idim ;
  598.       lnom = 'EXTRAIRE' lvp &iidim ;
  599.       A . 'VAR' . &iidim . 'NOMDDL' = 'MOTS' lnom ;
  600.       A . 'VAR' . &iidim . 'DISC'   = discv ;
  601.       'SI' ('EXISTE' chpop) ;
  602.          A . 'VAR' . &iidim . 'VALEUR'  = 'EXCO' lnom chpop lnom ;
  603.       'FINSI' ;         
  604.    'FIN' iidim ;      
  605. *
  606.    A . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  607.    A . 'DAT' . 1 . 'DISC'   = gdisc ;
  608.    A . 'DAT' . 1 . 'VALEUR' = rmt ;
  609.    A . 'DAT' . 2 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  610.    A . 'DAT' . 2 . 'DISC'   = discc ;
  611.    A . 'DAT' . 2 . 'VALEUR' = coef ;
  612.    A . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  613.    A . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
  614.    A . 'COF' . 2 . 'COMPOR' = 'IDEN' ;
  615.    A . 'COF' . 2 . 'LDAT'   = 'LECT' 2 ;
  616. *
  617.    A . 1 . 1 . 1 = 'LECT' 2 ;
  618.    A . 2 . 1 . 2 = 'LECT' 2 ;
  619.    A . 3 . 1 . 0 = 'LECT' -1 2 ;
  620.    A . 4 . 2 . 1 = 'LECT' 2 ;
  621.    A . 5 . 2 . 2 = 'LECT' 2 ;
  622. *
  623.    numdat = 2 ;
  624.    numcof = 2 ;
  625. *
  626.    B = ININLIN numop numvar numdat numcof numder ;
  627.    'REPETER' iidim idim ;
  628.       lnom = 'EXTRAIRE' lvd &iidim ;
  629.       B . 'VAR' . &iidim . 'NOMDDL' = 'MOTS' lnom ;
  630.       B . 'VAR' . &iidim . 'DISC'   = discv ;
  631.       'SI' ('EXISTE' chpod) ;
  632.          B . 'VAR' . &iidim . 'VALEUR'  = 'EXCO' lnom chpod lnom ;
  633.       'FINSI' ;         
  634.    'FIN' iidim ;      
  635. *
  636.    B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  637.    B . 'DAT' . 1 . 'DISC'   = gdisc ;
  638.    B . 'DAT' . 1 . 'VALEUR' = rmt ;
  639.    B . 'DAT' . 2 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  640.    B . 'DAT' . 2 . 'DISC'   = 'CSTE' ;
  641.    B . 'DAT' . 2 . 'VALEUR' = deupi ;
  642.    B . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  643.    B . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
  644.    B . 'COF' . 2 . 'COMPOR' = 'IDEN' ;
  645.    B . 'COF' . 2 . 'LDAT'   = 'LECT' 2 ;
  646. *
  647.    B . 1 . 1 . 1 = 'LECT' 1 2 ;
  648.    B . 2 . 1 . 2 = 'LECT' 1 2 ;
  649.    B . 3 . 1 . 0 = 'LECT' 2 ;
  650.    B . 4 . 2 . 1 = 'LECT' 1 2 ;
  651.    B . 5 . 2 . 2 = 'LECT' 1 2 ;
  652. 'SINON' ;
  653.    numop  = '**' idim 2 ;
  654. *!   numop  = idim ;
  655.    numder = idim ;
  656.    numvar = idim ;
  657.    numdat = 1 ;
  658.    numcof = 1 ;
  659. *
  660.    A = ININLIN numop numvar numdat numcof numder ;
  661.    'REPETER' iidim idim ;
  662.       lnom = 'EXTRAIRE' lvp &iidim ;
  663.       A . 'VAR' . &iidim . 'NOMDDL' = 'MOTS' lnom ;
  664.       A . 'VAR' . &iidim . 'DISC'   = discv ;
  665.       'SI' ('EXISTE' chpop) ;
  666.          A . 'VAR' . &iidim . 'VALEUR'  = 'EXCO' lnom chpop lnom ;
  667.       'FINSI' ;         
  668.    'FIN' iidim ;      
  669. *
  670.    A . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  671.    A . 'DAT' . 1 . 'DISC'   = discc ;
  672.    A . 'DAT' . 1 . 'VALEUR' = coef ;
  673. *   
  674.    A . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  675.    A . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
  676. *
  677.    iop = 0 ;
  678.    'REPETER' iidim idim ;
  679. *   'REPETER' iidim 1 ;
  680.       'REPETER' jidim idim ;
  681.          iop = '+' iop 1 ;
  682.          A . iop . &iidim . &jidim = 'LECT' 1 ;
  683.       'FIN' jidim ;
  684.    'FIN' iidim ;      
  685. *
  686.    numdat = 0 ;
  687.    numcof = 0 ;
  688. *
  689.    B = ININLIN numop numvar numdat numcof numder ;
  690.    'REPETER' iidim idim ;
  691.       lnom = 'EXTRAIRE' lvd &iidim ;
  692.       B . 'VAR' . &iidim . 'NOMDDL' = 'MOTS' lnom ;
  693.       B . 'VAR' . &iidim . 'DISC'   = discv ;
  694.       'SI' ('EXISTE' chpod) ;
  695.          B . 'VAR' . &iidim . 'VALEUR'  = 'EXCO' lnom chpod lnom ;
  696.       'FINSI' ;         
  697.    'FIN' iidim ;      
  698. *
  699.    iop = 0 ;
  700.    'REPETER' iidim idim ;
  701. *!   'REPETER' iidim 1 ;
  702.       'REPETER' jidim idim ;
  703.          iop = '+' iop 1 ;
  704.          B . iop . &iidim . &jidim = 'LECT' ;
  705.       'FIN' jidim ;
  706.    'FIN' iidim ;      
  707. 'FINSI' ;
  708. *
  709.    mgrig = 'NLIN' gdisc _mt A B methgau ;
  710. * Integration par parties
  711.    mgrig = '*' mgrig -1.D0 ;
  712. *
  713. 'RESPRO' mgrig ;
  714. 'FINPROC' ;
  715. *
  716. * End of procedure file GRIG
  717. *
  718. *ENDPROCEDUR grig
  719. *BEGINPROCEDUR grig2
  720. ************************************************************************
  721. * NOM         : GRIG2
  722. * DESCRIPTION : Additif à la matrice de rigidité axisymétrique 
  723. *               de forme (tgradu . gradv)
  724. *
  725. *
  726. * LANGAGE     : GIBIANE-CAST3M
  727. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  728. *               mél : gounand@semt2.smts.cea.fr
  729. **********************************************************************
  730. * VERSION    : v1, 13/05/2004, version initiale
  731. * HISTORIQUE : v1, 13/05/2004, création
  732. * HISTORIQUE :
  733. * HISTORIQUE :
  734. ************************************************************************
  735. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  736. * en cas de modification de ce sous-programme afin de faciliter
  737. * la maintenance !
  738. ************************************************************************
  739. *
  740. *
  741. 'DEBPROC' GRIG2 ;
  742. 'ARGUMENT'     _mt*'MAILLAGE' ;
  743. 'ARGUMENT'   gdisc*'MOT     ' ;
  744. 'ARGUMENT'   discv*'MOT     ' ;
  745. 'ARGUMENT'   lvp*'LISTMOTS' ;
  746. 'ARGUMENT'   lvd*'LISTMOTS' ;
  747. 'ARGUMENT' methgau/'MOT     ' ;
  748. 'SI' ('NON' ('EXISTE' methgau)) ;
  749.     methgau = 'GAU7' ;
  750. 'FINSI' ;      
  751. *
  752.    vdim = 'VALEUR' 'DIME' ;
  753.    vmod = 'VALEUR' 'MODE' ;
  754.    idim = 0 ;
  755. *   'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  756. *      idim = 2 ;
  757. *      iaxi = FAUX ;
  758. *   'FINSI' ;
  759.    'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  760.       idim = 2 ;
  761.       iaxi = VRAI ;
  762.    'FINSI' ;
  763. *   'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  764. *      idim = 3 ;
  765. *      iaxi = FAUX ;
  766. **      vcomp = 'MOTS' 'UX' 'UY' 'UZ' ;
  767. *   'FINSI' ;
  768. *   'SI' ('EGA' vdim 1) ;
  769. *      idim = 1 ;
  770. *      iaxi = FAUX ;
  771. *   'FINSI' ;
  772.    'SI' ('EGA' idim 0) ;
  773.       'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  774.    'FINSI' ;
  775.    'SI' iaxi ;
  776.       rmt = 'COORDONNEE' 1 _mt ;
  777.       deupi = ('*' PI 2.D0) ;
  778.    'FINSI' ;      
  779. *
  780.    numop  = 5 ;
  781.    numder = idim ;
  782.    numvar = 2 ;
  783.    numdat = 1 ;
  784.    numcof = 1 ;
  785. *
  786.    A = ININLIN numop numvar numdat numcof numder ;
  787.    'REPETER' iidim idim ;
  788.       A . 'VAR' . &iidim . 'NOMDDL' = 'MOTS' ('EXTRAIRE' lvp &iidim) ;
  789.       A . 'VAR' . &iidim . 'DISC'   = discv ;
  790.    'FIN' iidim ;      
  791. *
  792.    A . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  793.    A . 'DAT' . 1 . 'DISC'   = gdisc ;
  794.    A . 'DAT' . 1 . 'VALEUR' = rmt ;
  795.    A . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  796.    A . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
  797. *
  798.    A . 1 . 1 . 1 = 'LECT' ;
  799.    A . 2 . 2 . 1 = 'LECT' ;
  800.    A . 3 . 1 . 0 = 'LECT' -1 ;
  801.    A . 4 . 1 . 2 = 'LECT' ;
  802.    A . 5 . 2 . 2 = 'LECT' ;
  803. *   
  804.    numdat = 2 ;
  805.    numcof = 2 ;
  806. *
  807.    B = ININLIN numop numvar numdat numcof numder ;
  808.    'REPETER' iidim idim ;
  809.       B . 'VAR' . &iidim . 'NOMDDL' = 'MOTS' ('EXTRAIRE' lvd &iidim) ;
  810.       B . 'VAR' . &iidim . 'DISC'   = discv ;
  811.    'FIN' iidim ;      
  812. *
  813.    B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  814.    B . 'DAT' . 1 . 'DISC'   = gdisc ;
  815.    B . 'DAT' . 1 . 'VALEUR' = rmt ;
  816.    B . 'DAT' . 2 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  817.    B . 'DAT' . 2 . 'DISC'   = 'CSTE' ;
  818.    B . 'DAT' . 2 . 'VALEUR' = deupi ;
  819.    B . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  820.    B . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
  821.    B . 'COF' . 2 . 'COMPOR' = 'IDEN' ;
  822.    B . 'COF' . 2 . 'LDAT'   = 'LECT' 2 ;
  823. *
  824.    B . 1 . 1 . 1 = 'LECT' 1 2 ;
  825.    B . 2 . 1 . 2 = 'LECT' 1 2 ;
  826.    B . 3 . 1 . 0 = 'LECT' 2 ;
  827.    B . 4 . 2 . 1 = 'LECT' 1 2 ;
  828.    B . 5 . 2 . 2 = 'LECT' 1 2 ;
  829. *
  830.    mgrig = 'NLIN' gdisc _mt A B methgau ;
  831. * Integration par parties
  832.    mgrig = '*' mgrig -1.D0 ;
  833. *
  834. 'RESPRO' mgrig ;
  835. 'FINPROC' ;
  836. *
  837. * End of procedure file GRIG2
  838. *
  839. *ENDPROCEDUR grig2
  840. *BEGINPROCEDUR grig3
  841. ************************************************************************
  842. * NOM         : GRIG3
  843. * DESCRIPTION : Additif à la matrice de rigidité axisymétrique 
  844. *               de forme (div u . div v)
  845. *
  846. *
  847. * LANGAGE     : GIBIANE-CAST3M
  848. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  849. *               mél : gounand@semt2.smts.cea.fr
  850. **********************************************************************
  851. * VERSION    : v1, 13/05/2004, version initiale
  852. * HISTORIQUE : v1, 13/05/2004, création
  853. * HISTORIQUE :
  854. * HISTORIQUE :
  855. ************************************************************************
  856. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  857. * en cas de modification de ce sous-programme afin de faciliter
  858. * la maintenance !
  859. ************************************************************************
  860. *
  861. *
  862. 'DEBPROC' GRIG3 ;
  863. 'ARGUMENT'     _mt*'MAILLAGE' ;
  864. 'ARGUMENT'   gdisc*'MOT     ' ;
  865. 'ARGUMENT'   discv*'MOT     ' ;
  866. 'ARGUMENT'   lvp*'LISTMOTS' ;
  867. 'ARGUMENT'   lvd*'LISTMOTS' ;
  868. 'ARGUMENT' methgau/'MOT     ' ;
  869. 'SI' ('NON' ('EXISTE' methgau)) ;
  870.     methgau = 'GAU7' ;
  871. 'FINSI' ;      
  872. *
  873.    vdim = 'VALEUR' 'DIME' ;
  874.    vmod = 'VALEUR' 'MODE' ;
  875.    idim = 0 ;
  876. *   'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  877. *      idim = 2 ;
  878. *      iaxi = FAUX ;
  879. *   'FINSI' ;
  880.    'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  881.       idim = 2 ;
  882.       iaxi = VRAI ;
  883.    'FINSI' ;
  884. *   'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  885. *      idim = 3 ;
  886. *      iaxi = FAUX ;
  887. **      vcomp = 'MOTS' 'UX' 'UY' 'UZ' ;
  888. *   'FINSI' ;
  889. *   'SI' ('EGA' vdim 1) ;
  890. *      idim = 1 ;
  891. *      iaxi = FAUX ;
  892. *   'FINSI' ;
  893.    'SI' ('EGA' idim 0) ;
  894.       'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  895.    'FINSI' ;
  896.    'SI' iaxi ;
  897.       rmt = 'COORDONNEE' 1 _mt ;
  898.       deupi = ('*' PI 2.D0) ;
  899.    'FINSI' ;      
  900. *
  901.    numop  = 1 ;
  902.    numder = idim ;
  903.    numvar = 2 ;
  904.    numdat = 1 ;
  905.    numcof = 1 ;
  906. *
  907.    A = ININLIN numop numvar numdat numcof numder ;
  908.    'REPETER' iidim idim ;
  909.       A . 'VAR' . &iidim . 'NOMDDL' = 'MOTS' ('EXTRAIRE' lvp &iidim) ;
  910.       A . 'VAR' . &iidim . 'DISC'   = discv ;
  911.    'FIN' iidim ;      
  912. *
  913.    A . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  914.    A . 'DAT' . 1 . 'DISC'   = gdisc ;
  915.    A . 'DAT' . 1 . 'VALEUR' = rmt ;
  916.    A . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  917.    A . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
  918. *
  919.    A . 1 . 1 . 0 = 'LECT' -1 ;
  920.    A . 1 . 1 . 1 = 'LECT' ;
  921.    A . 1 . 2 . 2 = 'LECT' ;
  922. *
  923.    numdat = 2 ;
  924.    numcof = 2 ;
  925. *
  926.    B = ININLIN numop numvar numdat numcof numder ;
  927.    'REPETER' iidim idim ;
  928.       B . 'VAR' . &iidim . 'NOMDDL' = 'MOTS' ('EXTRAIRE' lvd &iidim) ;
  929.       B . 'VAR' . &iidim . 'DISC'   = discv ;
  930.    'FIN' iidim ;      
  931. *
  932.    B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  933.    B . 'DAT' . 1 . 'DISC'   = gdisc ;
  934.    B . 'DAT' . 1 . 'VALEUR' = rmt ;
  935.    B . 'DAT' . 2 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  936.    B . 'DAT' . 2 . 'DISC'   = 'CSTE' ;
  937.    B . 'DAT' . 2 . 'VALEUR' = deupi ;
  938.    B . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  939.    B . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
  940.    B . 'COF' . 2 . 'COMPOR' = 'IDEN' ;
  941.    B . 'COF' . 2 . 'LDAT'   = 'LECT' 2 ;
  942. *
  943.    B . 1 . 1 . 0 = 'LECT' 2 ;
  944.    B . 1 . 1 . 1 = 'LECT' 1 2 ;
  945.    B . 1 . 2 . 2 = 'LECT' 1 2 ;
  946. *
  947.    mgrig = 'NLIN' gdisc _mt A B methgau ;
  948. * Integration par parties
  949.    mgrig = '*' mgrig -1.D0 ;
  950. *
  951. 'RESPRO' mgrig ;
  952. 'FINPROC' ;
  953. *
  954. * End of procedure file GRIG3
  955. *
  956. *ENDPROCEDUR grig3
  957. *BEGINPROCEDUR gbbt2
  958. ************************************************************************
  959. * NOM         : GBBT2
  960. * DESCRIPTION : Copie de GBBT
  961. *               Version customisée pour la sphère
  962. *
  963. *
  964. * LANGAGE     : GIBIANE-CAST3M
  965. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  966. *               mél : gounand@semt2.smts.cea.fr
  967. **********************************************************************
  968. * VERSION    : v1, 05/10/2006, version initiale
  969. * HISTORIQUE : v1, 05/10/2006, création
  970. * HISTORIQUE :
  971. * HISTORIQUE :
  972. ************************************************************************
  973. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  974. * en cas de modification de ce sous-programme afin de faciliter
  975. * la maintenance !
  976. ************************************************************************
  977. *
  978. *
  979. 'DEBPROC' GBBT2 ;
  980. 'ARGUMENT'     _mt*'MAILLAGE' ;
  981. 'ARGUMENT'   gdisc*'MOT     ' ;
  982. 'ARGUMENT'   discv*'MOT     ' ;
  983. 'ARGUMENT'   lvp*'LISTMOTS' ;
  984. 'ARGUMENT'   lvd*'LISTMOTS' ;
  985. 'ARGUMENT'   discp*'MOT     ' ;
  986. 'ARGUMENT'   lpp*'LISTMOTS' ;
  987. 'ARGUMENT'   lpd*'LISTMOTS' ;
  988. 'ARGUMENT' coef/'FLOTTANT' ;
  989.    'SI' ('NON' ('EXISTE' coef)) ;
  990.       'ARGUMENT' coef2/'CHPOINT ' ;
  991.       'SI' ('NON' ('EXISTE' coef2)) ;
  992.          'ERREUR' 'Il faut donner un coef FLOTTANT ou CHPOINT' ;
  993.       'SINON' ;
  994.          coef = coef2 ;
  995.          'ARGUMENT' discc*'MOT     ' ;
  996.       'FINSI' ;                  
  997.    'SINON' ;
  998.       discc = 'CSTE' ;
  999.    'FINSI' ;            
  1000. 'ARGUMENT' methgau/'MOT     ' ;
  1001.    'SI' ('NON' ('EXISTE' methgau)) ;
  1002.       methgau = 'GAU7' ;
  1003.    'FINSI' ;      
  1004. *
  1005.    vdim = 'VALEUR' 'DIME' ;
  1006.    vmod = 'VALEUR' 'MODE' ;
  1007.    idim = 0 ;
  1008.    'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  1009.       idim = 2 ;
  1010.       iaxi = FAUX ;
  1011.    'FINSI' ;
  1012.    'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  1013.       idim = 2 ;
  1014.       iaxi = VRAI ;
  1015.    'FINSI' ;
  1016.    'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  1017.       idim = 3 ;
  1018.       iaxi = FAUX ;
  1019.    'FINSI' ;
  1020.    'SI' ('EGA' idim 0) ;
  1021.       'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  1022.    'FINSI' ;
  1023.    'SI' iaxi ;
  1024.       dp = ('*' PI 2.D0) ;
  1025.       rmt = 'COORDONNEE' 1 _mt ;
  1026.    'FINSI' ;      
  1027. *   
  1028.    numop  = 2 ;
  1029.    numder = idim ;
  1030.    mmp = 'MOTS' nomp ;
  1031.    idim1 = '+' idim 1 ;
  1032.    numvar = idim1 ;
  1033.    'SI' iaxi ;
  1034.       numdat = 3 ;
  1035.       numcof = 3 ;
  1036.    'SINON' ;      
  1037.       numdat = 1 ;
  1038.       numcof = 1 ;
  1039.    'FINSI' ;      
  1040. *
  1041.    A = ININLIN numop numvar numdat numcof numder ;   
  1042.    'REPETER' iidim idim ;
  1043.       A . 'VAR' . &iidim . 'NOMDDL' = 'MOTS' ('EXTRAIRE' lvp &iidim) ;
  1044.       A . 'VAR' . &iidim . 'DISC'   = discv ;
  1045.    'FIN' iidim ;
  1046.    A . 'VAR' . idim1 . 'NOMDDL' = lpp ;
  1047.    A . 'VAR' . idim1 . 'DISC'   = discp ;
  1048.    A . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  1049.    A . 'DAT' . 1 . 'DISC'   = discc ;
  1050.    A . 'DAT' . 1 . 'VALEUR' = coef ;
  1051.    A . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  1052.    A . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
  1053. *
  1054.    'SI' iaxi ;
  1055.       A . 'DAT' . 2 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  1056.       A . 'DAT' . 2 . 'DISC'   = 'CSTE' ;
  1057.       A . 'DAT' . 2 . 'VALEUR' = dp ;
  1058.       A . 'COF' . 2 . 'COMPOR' = 'IDEN' ;
  1059.       A . 'COF' . 2 . 'LDAT'   = 'LECT' 2 ;
  1060.       A . 'DAT' . 3 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  1061.       A . 'DAT' . 3 . 'DISC'   = gdisc ;
  1062.       A . 'DAT' . 3 . 'VALEUR' = rmt ;
  1063.       A . 'COF' . 3 . 'COMPOR' = 'IDEN' ;
  1064.       A . 'COF' . 3 . 'LDAT'   = 'LECT' 3 ;
  1065.    'FINSI' ;
  1066. *
  1067.    'SI' iaxi ;
  1068.       'REPETER' iidim idim ;
  1069.          A . 1 . &iidim . &iidim  = 'LECT' 1 2 3 ;
  1070.       'FIN' iidim ;
  1071.       A . 1 . 1 . 0 = 'LECT' 1 2 ;
  1072.    'SINON' ;
  1073.       'REPETER' iidim idim ;
  1074.          A . 1 . &iidim . &iidim  = 'LECT' 1 ;
  1075.       'FIN' iidim ;
  1076.    'FINSI' ;
  1077.    A . 2 . idim1 . 0 = 'LECT' ;
  1078. *
  1079.    'SI' iaxi ;
  1080.       numdat = 3 ;
  1081.       numcof = 3 ;
  1082.    'SINON' ;      
  1083.       numdat = 1 ;
  1084.       numcof = 1 ;
  1085.    'FINSI' ;      
  1086.    B = ININLIN numop numvar numdat numcof numder ;   
  1087.    'REPETER' iidim idim ;
  1088.       B . 'VAR' . &iidim . 'NOMDDL' = 'MOTS' ('EXTRAIRE' lvd &iidim) ;
  1089.       B . 'VAR' . &iidim . 'DISC'   = discv ;
  1090.    'FIN' iidim ;
  1091.    B . 'VAR' . idim1 . 'NOMDDL' = lpd ;
  1092.    B . 'VAR' . idim1 . 'DISC'   = discp ;
  1093.    B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  1094.    B . 'DAT' . 1 . 'DISC'   = discc ;
  1095.    B . 'DAT' . 1 . 'VALEUR' = coef ;
  1096.    B . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  1097.    B . 'COF' . 1 . 'LDAT'   = 'LECT' 1 ;
  1098. *
  1099.    'SI' iaxi ;
  1100.       B . 'DAT' . 2 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  1101.       B . 'DAT' . 2 . 'DISC'   = 'CSTE' ;
  1102.       B . 'DAT' . 2 . 'VALEUR' = dp ;
  1103.       B . 'COF' . 2 . 'COMPOR' = 'IDEN' ;
  1104.       B . 'COF' . 2 . 'LDAT'   = 'LECT' 2 ;
  1105.       B . 'DAT' . 3 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  1106.       B . 'DAT' . 3 . 'DISC'   = gdisc ;
  1107.       B . 'DAT' . 3 . 'VALEUR' = rmt ;
  1108.       B . 'COF' . 3 . 'COMPOR' = 'IDEN' ;
  1109.       B . 'COF' . 3 . 'LDAT'   = 'LECT' 3 ;
  1110.    'FINSI' ;
  1111. *
  1112.    'SI' iaxi ;
  1113.       'REPETER' iidim idim ;
  1114.          B . 2 . &iidim . &iidim  = 'LECT' 1 2 3 ;
  1115.       'FIN' iidim ;
  1116.       B . 2 . 1 . 0 = 'LECT' 1 2 ;
  1117.    'SINON' ;
  1118.       'REPETER' iidim idim ;
  1119.          B . 2 . &iidim . &iidim  = 'LECT' 1 ;
  1120.       'FIN' iidim ;
  1121.    'FINSI' ;
  1122.    B . 1 . idim1 . 0 = 'LECT' ;
  1123. *
  1124.    mgbbt2 = 'NLIN' gdisc _mt A B methgau ;
  1125. *
  1126. 'RESPRO' mgbbt2 ;
  1127. 'FINPROC' ;
  1128. *
  1129. * End of procedure file GBBT2
  1130. *
  1131. *ENDPROCEDUR gbbt2
  1132. *BEGINPROCEDUR log10
  1133. ************************************************************************
  1134. * NOM         : LOG10
  1135. * DESCRIPTION : Log_10
  1136. *
  1137. *
  1138. *
  1139. * LANGAGE     : GIBIANE-CAST3M
  1140. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1141. *               mél : gounand@semt2.smts.cea.fr
  1142. **********************************************************************
  1143. * VERSION    : v1, 18/02/2003, version initiale
  1144. * HISTORIQUE : v1, 18/02/2003, création
  1145. * HISTORIQUE :
  1146. * HISTORIQUE :
  1147. ************************************************************************
  1148. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1149. * en cas de modification de ce sous-programme afin de faciliter
  1150. * la maintenance !
  1151. ************************************************************************
  1152. *
  1153. *
  1154. 'DEBPROC' LOG10 ;
  1155. 'REPETER' bouc ;
  1156.    ok = FAUX ;
  1157.    'ARGUMENT' fl/'FLOTTANT' ;
  1158.    'ARGUMENT' lr/'LISTREEL' ;
  1159.    'ARGUMENT' cp/'CHPOINT ' ;
  1160.    'ARGUMENT' cm/'MCHAML  ' ;
  1161.    'SI' ('EXISTE' fl) ;
  1162.       ok = VRAI ;
  1163.       'RESPRO' ('/' ('LOG' fl) ('LOG' 10.D0)) ;
  1164.    'FINSI' ;
  1165.    'SI' ('EXISTE' lr) ;
  1166.       ok = VRAI ;
  1167.       'RESPRO' ('/' ('LOG' lr) ('LOG' 10.D0)) ;
  1168.    'FINSI' ;
  1169.    'SI' ('EXISTE' cp) ;
  1170.       ok = VRAI ;
  1171.       'RESPRO' ('/' ('LOG' cp) ('LOG' 10.D0)) ;
  1172.    'FINSI' ;
  1173.    'SI' ('EXISTE' cm) ;
  1174.       ok = VRAI ;
  1175.       'RESPRO' ('/' ('LOG' cm) ('LOG' 10.D0)) ;
  1176.    'FINSI' ;
  1177.    'SI' ('NON' ok) ;
  1178.       'QUITTER' bouc ;
  1179.    'FINSI' ;
  1180. 'FIN' bouc ;         
  1181. *
  1182. * End of procedure file LOG10
  1183. *
  1184. 'FINPROC' ;
  1185. *ENDPROCEDUR log10
  1186. *BEGINPROCEDUR dessevol
  1187. ************************************************************************
  1188. * NOM         : DESSEVOL
  1189. * DESCRIPTION : Dessine des évolutions : choisit automatiquement
  1190. *               les options, marqueurs, couleurs...
  1191. *
  1192. *
  1193. * LANGAGE     : GIBIANE-CAST3M
  1194. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1195. *               mél : gounand@semt2.smts.cea.fr
  1196. **********************************************************************
  1197. * VERSION    : v1, 16/11/2004, version initiale
  1198. * HISTORIQUE : v1, 16/11/2004, création
  1199. * HISTORIQUE :
  1200. * HISTORIQUE :
  1201. ************************************************************************
  1202. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1203. * en cas de modification de ce sous-programme afin de faciliter
  1204. * la maintenance !
  1205. ************************************************************************
  1206. *
  1207. *
  1208. 'DEBPROC' DESSEVOL ;
  1209. 'ARGUMENT' evtot*'EVOLUTION' ;
  1210. 'ARGUMENT' tabt*'TABLE' ;
  1211. 'ARGUMENT' tit*'MOT' ;
  1212. 'ARGUMENT' tix*'MOT' ;
  1213. 'ARGUMENT' tiy*'MOT' ;
  1214. 'ARGUMENT' lnclk/'LOGIQUE' ;
  1215. 'ARGUMENT' nb/'ENTIER' ;
  1216. *
  1217. 'SI' ('NON' ('EXISTE' lnclk)) ;
  1218.    lnclk = FAUX ;
  1219. 'FINSI' ;   
  1220. *
  1221. 'SI' ('NON' ('EXISTE' nb)) ;
  1222.    nb = 3 ;
  1223. 'FINSI' ;   
  1224. *
  1225. nt  = 'DIME' tabt ;
  1226. nev = 'DIME' evtot ;
  1227. *
  1228. * Attention, dans evtot, il y a une évolution avec des noms de points ?
  1229. *
  1230. *'SI' ('NEG' nev nt) ;
  1231. *   cherr = 'CHAINE' 'Evolution and title table : not same dim.' ;
  1232. *   'ERREUR' cherr ;
  1233. *'FINSI' ;
  1234. *
  1235. tev = 'TABLE' ;
  1236. tev . 'TITRE' = tabt ;
  1237. *
  1238. toto = 'TABLE' ;
  1239. *
  1240. lcoul = 'MOTS' 'TURQ' 'VERT' 'JAUN' 'ROSE' 'ROUG' 'BLEU' ;
  1241. lmarq = 'MOTS' 'TRIB' 'TRIA' 'LOSA' 'CARR' 'ETOI' 'PLUS' 'CROI' ;
  1242. ltirr = 'MOTS' 'TIRR' 'TIRC' 'TIRL' 'TIRM' ;
  1243. *
  1244. 'SI' ('EGA' nb 0) ;
  1245.    ev2 = evtot ;
  1246. 'SINON' ;
  1247.    icou = 0 ;
  1248.    'REPETER' iev nev ;
  1249.       ii = &iev ;
  1250.       evi = 'EXTRAIRE' evtot 'COUR' ii ;
  1251.       'SI' ('NEG' ('TYPE' ('EXTRAIRE' evi 'ORDO')) 'LISTMOTS') ;
  1252.          icou = '+' icou 1 ;
  1253.       'FINSI' ;         
  1254. *      ii2 = '/' ('+' ii 1) 2 ;
  1255. *      ci  = EXMOMOD lcoul ii2 ;
  1256. *      ci  = EXMOMOD lcoul ii ;
  1257.       ci  = EXMOMOD lcoul icou ;
  1258.       APPEND toto 'EVOLUTION' ('COULEUR' evi ci) ;
  1259.    'FIN' iev ;
  1260.    ev2 = toto . 'EVOLUTION' ;
  1261. 'FINSI' ;
  1262. *      
  1263. 'REPETER' iev nev ;
  1264.    ii = &iev ;
  1265.    mi = EXMOMOD lmarq ii ;
  1266.    ti = EXMOMOD ltirr ii ;
  1267.    'SI' ('>' nb 2) ;
  1268.       tev . ii = 'CHAINE' 'MARQ ' mi ' ' ti ;
  1269.    'FINSI' ;      
  1270.    'SI' ('>' nb 1) ;
  1271.       tev . ii = 'CHAINE' 'MARQ ' mi ;
  1272.    'FINSI' ;      
  1273. 'FIN' iev ;   
  1274. *
  1275. 'SI' lnclk ;
  1276.    'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
  1277.    'NCLK' ;
  1278. 'SINON' ;   
  1279.    'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev ;
  1280. 'FINSI' ;   
  1281. *
  1282. * End of procedure file DESSEVOL
  1283. *
  1284. 'FINPROC' ;
  1285. *ENDPROCEDUR dessevol
  1286. *BEGINPROCEDUR exmomod
  1287. ************************************************************************
  1288. * NOM         : EXMOMOD
  1289. * DESCRIPTION : Extraction d'un mot d'un listmots
  1290. *
  1291. *
  1292. *
  1293. * LANGAGE     : GIBIANE-CAST3M
  1294. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1295. *               mél : gounand@semt2.smts.cea.fr
  1296. **********************************************************************
  1297. * VERSION    : v1, 23/06/2003, version initiale
  1298. * HISTORIQUE : v1, 23/06/2003, création
  1299. * HISTORIQUE :
  1300. * HISTORIQUE :
  1301. ************************************************************************
  1302. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1303. * en cas de modification de ce sous-programme afin de faciliter
  1304. * la maintenance !
  1305. ************************************************************************
  1306. *
  1307. *
  1308. 'DEBPROC' EXMOMOD ;
  1309. 'ARGUMENT' lm*'LISTMOTS' i*'ENTIER' ;
  1310. j = 'DIME' lm ;
  1311. k = '+' (MODULO ('-' i 1) j) 1 ;
  1312. lemot = 'EXTRAIRE' lm k ;
  1313. * Usage de l'opérateur text pour éviter que lemot
  1314. * ne soit interprété comme un opérateur
  1315. 'RESPRO' 'TEXTE' lemot ;
  1316. *
  1317. * End of procedure file EXMOMOD
  1318. *
  1319. 'FINPROC' ;
  1320. *ENDPROCEDUR exmomod
  1321. *BEGINPROCEDUR modulo
  1322. ************************************************************************
  1323. * NOM         : MODULO
  1324. * DESCRIPTION : Calcule un entier modulo un autre...
  1325. *
  1326. *
  1327. *
  1328. * LANGAGE     : GIBIANE-CAST3M
  1329. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1330. *               mél : gounand@semt2.smts.cea.fr
  1331. **********************************************************************
  1332. * VERSION    : v1, 15/10/2002, version initiale
  1333. * HISTORIQUE : v1, 15/10/2002, création
  1334. * HISTORIQUE :
  1335. * HISTORIQUE :
  1336. ************************************************************************
  1337. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1338. * en cas de modification de ce sous-programme afin de faciliter
  1339. * la maintenance !
  1340. ************************************************************************
  1341. *
  1342. *
  1343. 'DEBPROC' MODULO ;
  1344. 'ARGUMENT' i*'ENTIER' j*'ENTIER' ;
  1345. 'SI' ('EGA' j 0) ;
  1346.   'MESSAGE' 'Impossible de faire modulo 0' ;
  1347.   'ERREUR' 5 ;
  1348. 'SINON' ;
  1349.   k=i '/' j ;
  1350.   mod=i '-' ( k '*'j ) ;
  1351.   'RESPRO' mod ;
  1352. 'FINSI' ;
  1353. *
  1354. * End of procedure file MODULO
  1355. *
  1356. 'FINPROC' ;
  1357. *ENDPROCEDUR modulo
  1358. *BEGINPROCEDUR append
  1359. ************************************************************************
  1360. * NOM         : APPEND
  1361. * DESCRIPTION : Rajoute :
  1362. *               - un entier à un listentier
  1363. *               - un réel   à un listreel
  1364. *               - un objet (liste, evolution, matrice ou chpoint)
  1365. *                 à un indice de table ('MOT' ou 'ENTIER')
  1366. *                    * si l'indice n'existe pas
  1367. *                    * 'ET' si l'indice existe 
  1368. *                
  1369. *
  1370. *
  1371. * LANGAGE     : GIBIANE-CAST3M
  1372. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1373. *               mél : gounand@semt2.smts.cea.fr
  1374. **********************************************************************
  1375. * VERSION    : v1, 10/09/2004, version initiale
  1376. * HISTORIQUE : v1, 10/09/2004, création
  1377. * HISTORIQUE :
  1378. * HISTORIQUE :
  1379. ************************************************************************
  1380. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1381. * en cas de modification de ce sous-programme afin de faciliter
  1382. * la maintenance !
  1383. ************************************************************************
  1384. *
  1385. *
  1386. 'DEBPROC' APPEND ;
  1387. 'ARGUMENT' tab/'TABLE' ;
  1388. 'SI' ('EXISTE' tab) ;
  1389.    'ARGUMENT' itab/'MOT' ;
  1390.    'SI' ('NON' ('EXISTE' itab)) ;
  1391.       'ARGUMENT' itab*'ENTIER' ;
  1392.    'FINSI' ;      
  1393.    lobj = FAUX ;
  1394.    'SI' ('NON' lobj) ;
  1395.       'ARGUMENT' lr/'LISTREEL' ;
  1396.       'SI' ('EXISTE' lr) ;
  1397.          obj = lr ; lobj = VRAI ;
  1398.       'FINSI' ;
  1399.    'FINSI' ;               
  1400.    'SI' ('NON' lobj) ;
  1401.       'ARGUMENT' le/'LISTENTI' ;
  1402.       'SI' ('EXISTE' le) ;
  1403.          obj = le ; lobj = VRAI ;
  1404.       'FINSI' ;
  1405.    'FINSI' ;               
  1406.    'SI' ('NON' lobj) ;
  1407.       'ARGUMENT' lev/'EVOLUTION' ;
  1408.       'SI' ('EXISTE' lev) ;
  1409.          obj = lev ; lobj = VRAI ;
  1410.       'FINSI' ;
  1411.    'FINSI' ;               
  1412.    'SI' ('NON' lobj) ;
  1413.       'ARGUMENT' lm/'MAILLAGE' ;
  1414.       'SI' ('EXISTE' lm) ;
  1415.          obj = lm ; lobj = VRAI ;
  1416.       'FINSI' ;
  1417.    'FINSI' ;               
  1418.    'SI' ('NON' lobj) ;
  1419.       'ARGUMENT' chpo/'CHPOINT' ;
  1420.       'SI' ('EXISTE' chpo) ;
  1421.          obj = chpo ; lobj = VRAI ;
  1422.       'FINSI' ;
  1423.    'FINSI' ;               
  1424.    'SI' ('NON' lobj) ;
  1425.       'ARGUMENT' rig/'RIGIDITE' ;
  1426.       'SI' ('EXISTE' rig) ;
  1427.          obj = rig ; lobj = VRAI ;
  1428.       'FINSI' ;
  1429.    'FINSI' ;               
  1430.    'SI' ('NON' lobj) ;
  1431.       'ARGUMENT' matk/'MATRIK' ;
  1432.       'SI' ('EXISTE' matk) ;
  1433.          obj = matk ; lobj = VRAI ;
  1434.       'FINSI' ;
  1435.    'FINSI' ;
  1436.    'SI' ('NON' lobj) ;
  1437.       cherr = 'CHAINE'
  1438.        'Il faut fournir un objet liste, evolution, matrice ou chpoint.'
  1439.         ; 
  1440.       'ERREUR' cherr ;
  1441.    'FINSI' ;      
  1442.    'SI' ('EXISTE' tab itab) ;
  1443.       'SI' ('EGA' ('TYPE' obj) 'CHPOINT') ;
  1444.          tab . itab = '+' (tab . itab) obj ;
  1445.       'SINON' ;         
  1446.          tab . itab = 'ET' (tab . itab) obj ;
  1447.       'FINSI' ;         
  1448.    'SINON' ;
  1449.       tab . itab = obj ;
  1450.    'FINSI' ;
  1451.    'RESPRO' tab ;      
  1452. 'FINSI' ;   
  1453. 'ARGUMENT' lenti/'LISTENTI' ;
  1454. 'ARGUMENT' lreel/'LISTREEL' ;
  1455. 'SI' ('EXISTE' lenti) ;
  1456.    'ARGUMENT' enti*'ENTIER' ;
  1457.    lenti = 'ET' lenti ('LECT' enti) ;
  1458.    'RESPRO' lenti ;
  1459. 'FINSI' ;   
  1460. 'SI' ('EXISTE' lreel) ;
  1461.    'ARGUMENT' reel*'FLOTTANT' ;
  1462.    lreel = 'ET' lreel ('PROG' reel) ;
  1463.    'RESPRO' lreel ;
  1464. 'FINSI' ;   
  1465. *
  1466. * End of procedure file APPEND
  1467. *
  1468. 'FINPROC' ;
  1469. *ENDPROCEDUR append
  1470. *BEGINPROCEDUR isinlis
  1471. ************************************************************************
  1472. * NOM         : ISINLIS
  1473. * DESCRIPTION : Index d'un mot dans un liste de mots
  1474. *               (0 s'il n'y est pas)
  1475. *
  1476. *
  1477. *
  1478. * LANGAGE     : GIBIANE-CAST3M
  1479. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1480. *               mél : gounand@semt2.smts.cea.fr
  1481. **********************************************************************
  1482. * VERSION    : v1, 15/12/2004, version initiale
  1483. * HISTORIQUE : v1, 15/12/2004, création
  1484. * HISTORIQUE :
  1485. * HISTORIQUE :
  1486. ************************************************************************
  1487. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1488. * en cas de modification de ce sous-programme afin de faciliter
  1489. * la maintenance !
  1490. ************************************************************************
  1491. *
  1492. *
  1493. 'DEBPROC' ISINLIS ;
  1494. 'ARGUMENT' tutu*'MOT' ;
  1495. 'ARGUMENT' ltoto*'LISTMOTS' ;
  1496. 'ARGUMENT' lerr/'LOGIQUE' ;
  1497. *
  1498. 'SI' ('NON' ('EXISTE' lerr)) ;
  1499.    lerr = FAUX ;
  1500. 'FINSI' ;   
  1501. *
  1502. isin = 0 ;
  1503. ntoto = 'DIME' ltoto ;
  1504. 'SI' ('>' ntoto 0) ;
  1505.    'REPETER' itoto ntoto ;
  1506.       mtoto = 'EXTRAIRE' ltoto &itoto ;
  1507.       'SI' ('EGA' mtoto tutu) ;
  1508.          isin = &itoto ;
  1509.          'QUITTER' itoto ;
  1510.       'FINSI' ;
  1511.    'FIN' itoto ;
  1512. 'FINSI' ;
  1513. 'SI' lerr ;
  1514.    'SI' ('EGA' isin 0) ;
  1515.       cherr = 'CHAINE' ' ne contient pas ' tutu ;
  1516.       'LISTE' ltoto ;
  1517.       'ERREUR' cherr ;
  1518.    'FINSI' ;      
  1519. 'SINON' ;   
  1520.    'RESPRO' isin ;
  1521. 'FINSI' ;   
  1522. *
  1523. * End of procedure file ISINLIS
  1524. *
  1525. 'FINPROC' ;
  1526. *ENDPROCEDUR isinlis
  1527. *BEGINPROCEDUR formar
  1528. ************************************************************************
  1529. * NOM         : FORMAR
  1530. * DESCRIPTION : formate un réel de facon courte
  1531. *               pratique pour les noms de
  1532. *               sauvegarde
  1533. *               Exemples :
  1534. * 'MESSAGE' ('CHAINE' (formar 2.9e5   1)) ;
  1535. * 2.9E5
  1536. * 'MESSAGE' ('CHAINE' (formar -2.9e5  1)) ;
  1537. * -2.9E5
  1538. * 'MESSAGE' ('CHAINE' (formar 2.9e-5  1)) ;
  1539. * 2.9E-5
  1540. * 'MESSAGE' ('CHAINE' (formar -2.9e-5 1)) ;
  1541. * -2.9E-5
  1542. * 'MESSAGE' ('CHAINE' (formar 2.9     1)) ;
  1543. * 2.9
  1544. * 'MESSAGE' ('CHAINE' (formar -2.9    1)) ;
  1545. * -2.9
  1546. * 'MESSAGE' ('CHAINE' (formar 0       1)) ;
  1547. * 0
  1548. * 'MESSAGE' ('CHAINE' (formar 0       1)) ;
  1549. * 0
  1550. * 'MESSAGE' ('CHAINE' (formar 2.9e5   0)) ;
  1551. * 3E5
  1552. * 'MESSAGE' ('CHAINE' (formar -2.9e5  0)) ;
  1553. * -3E5
  1554. * 'MESSAGE' ('CHAINE' (formar 2.9e-5  0)) ;
  1555. * 3E-5
  1556. * 'MESSAGE' ('CHAINE' (formar -2.9e-5 0)) ;
  1557. * -3E-5
  1558. * 'MESSAGE' ('CHAINE' (formar 2.9     0)) ;
  1559. * 3
  1560. * 'MESSAGE' ('CHAINE' (formar -2.9    0)) ;
  1561. * -3
  1562. * 'MESSAGE' ('CHAINE' (formar 0       0)) ;
  1563. * 0
  1564. * 'MESSAGE' ('CHAINE' (formar 0       0)) ;
  1565. * 0
  1566. *               
  1567. *
  1568. *
  1569. * LANGAGE     : GIBIANE-CAST3M
  1570. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1571. *               mél : gounand@semt2.smts.cea.fr
  1572. **********************************************************************
  1573. * VERSION    : v1, 18/02/2003, version initiale
  1574. * HISTORIQUE : v1, 18/02/2003, création
  1575. * HISTORIQUE :
  1576. * HISTORIQUE :
  1577. ************************************************************************
  1578. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1579. * en cas de modification de ce sous-programme afin de faciliter
  1580. * la maintenance !
  1581. ************************************************************************
  1582. *
  1583. *
  1584. 'DEBPROC' FORMAR ;
  1585. 'ARGUMENT' fl*'FLOTTANT' ;
  1586. 'ARGUMENT' vir/'ENTIER  ' ;
  1587. 'SI' ('NON' ('EXISTE' vir)) ;
  1588.    vir = 1 ;
  1589. 'SINON' ;   
  1590.    'SI' ('<' vir 0) ;
  1591.       'ERREUR' 'fournir un entier positif' ;
  1592.    'FINSI' ;
  1593. 'FINSI' ;         
  1594. 'SI' ('<' ('ABS' fl) 10.D-100) ;
  1595.    chfl = 'CHAINE' '0' ;
  1596. 'SINON' ;
  1597. *! sans le 1.D-10, ca ne fonctionne pas
  1598. *! qd on entre pile poil une puissance de 10
  1599.    lfl = LOG10 ('ABS' fl) ;
  1600. *   lfl = '+' (LOG10 ('ABS' fl)) 1.D-10  ;
  1601.    slfl = 'SIGNE' ('ENTIER' lfl) ;
  1602.    'SI' ('EGA' slfl 1) ;
  1603.       elfl = 'ENTIER' lfl ;
  1604.    'SINON' ;
  1605.       elfl = '-' ('ENTIER' lfl) 1 ;
  1606.    'FINSI' ;
  1607.    man = '/' fl ('**' 10.D0 elfl) ;
  1608. *
  1609. * Une verrue pour des histoires de précision...
  1610. *   
  1611.    'SI' ('EGA' man 10.D0 ('**' 10.D0 ('*' vir -1.D0))) ;
  1612.       man  = '/' man 10.D0 ;
  1613.       elfl = '+' elfl 1 ;
  1614.    'FINSI' ;
  1615. *   
  1616.    sman = 'SIGNE' man ;
  1617.    'SI' ('EGA' sman 1) ;   
  1618.       fman = 'CHAINE' '(F' ('+' vir 2) '.0' vir ')' ;
  1619.    'SINON' ;
  1620.       fman = 'CHAINE' '(F' ('+' vir 3) '.0' vir ')' ;
  1621.    'FINSI' ;
  1622.    'SI' ('NEG' vir 0) ;   
  1623.       'SI' ('NEG' elfl 0) ;
  1624.          chfl = 'CHAINE' 'FORMAT' fman man 'E' elfl ;
  1625.       'SINON' ;
  1626.          chfl = 'CHAINE' 'FORMAT' fman man ;
  1627.       'FINSI' ;
  1628.    'SINON' ;
  1629.       man2 = 'ENTIER' ('+' man ('*' 0.5D0 sman)) ;
  1630.       'SI' ('NEG' elfl 0) ;
  1631.          chfl = 'CHAINE' man2 'E' elfl ;
  1632.       'SINON' ;
  1633.          chfl = 'CHAINE' man2 ;
  1634.       'FINSI' ;
  1635.    'FINSI' ;            
  1636. 'FINSI' ;   
  1637. 'RESPRO' chfl ;
  1638. *
  1639. * End of procedure file FORMAR
  1640. *
  1641. 'FINPROC' ;
  1642. *ENDPROCEDUR formar
  1643. ************************************************************************
  1644. * NOM         : TRAINEE_2D
  1645. * DESCRIPTION : Cas-test Traînée de Stokes (axisymétrique)
  1646. *
  1647. *
  1648. * LANGAGE     : GIBIANE-CAST3M
  1649. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  1650. *               mél : gounand@semt2.smts.cea.fr
  1651. **********************************************************************
  1652. * VERSION    : v1, 04/10/2006, version initiale
  1653. * HISTORIQUE : v1, 04/10/2006, création
  1654. * HISTORIQUE :
  1655. * HISTORIQUE :
  1656. ************************************************************************
  1657. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  1658. * en cas de modification de ce sous-programme afin de faciliter
  1659. * la maintenance !
  1660. ************************************************************************
  1661. *
  1662. complet  = FAUX ;
  1663. interact = FAUX ;
  1664. graph    = FAUX ;
  1665. *
  1666. 'OPTION' 'DIME' 2 'MODE' 'AXIS' ;
  1667. 'OPTION' 'ISOV' 'SURF' ;
  1668. 'SI' ('NON' interact) ;
  1669.   'OPTION' 'TRAC' 'PSC' ;
  1670. 'SINON' ;
  1671.    'OPTION' 'TRAC' 'X' ;  
  1672. 'FINSI' ;  
  1673. *
  1674. * Paramètres maillage
  1675. *
  1676. Ar = 2. ; Az = 2. ;
  1677. * 1 = triangle
  1678. * 2 = quadrangle
  1679. * 3 = quadrangle + triangles
  1680. ok = VRAI ;
  1681. 'REPETER' iimesh 2 ;
  1682. imesh = &iimesh ;
  1683. 'SI' ('EGA' imesh 1) ;
  1684.    tmesh = 'CHAINE' 'Triangle' ;
  1685. 'FINSI' ;   
  1686. 'SI' ('EGA' imesh 2) ;
  1687.    tmesh = 'CHAINE' 'Quadrangle' ;
  1688. 'FINSI' ;   
  1689. 'SI' ('EGA' imesh 3) ;
  1690.    tmesh = 'CHAINE' 'Qua et Tri' ;
  1691. 'FINSI' ;   
  1692. *
  1693. * Paramètres numériques (I)
  1694. * Espaces de discrétisation                        
  1695. * idisc = 1 : QUAF + CENTREP1 
  1696. * idisc = 2 : QUAD + LINE
  1697. * idisc = 3 : LINC + CSTE
  1698. * discrétisation du terme de contrainte
  1699. * irig = 1 : (grad u . grad v)
  1700. * irig = 2 : (grad u . grad v) + (tgradu . tgradv)
  1701. * irig = 3 : (grad u . grad v) + (div u . div v)
  1702. irig = 1 ;
  1703. tabevl2 = 'TABLE' ; tabevli = 'TABLE' ; tabevst = 'TABLE' ;
  1704. tabtl2  = 'TABLE' ; tabtli  = 'TABLE' ; tabtst  = 'TABLE' ;
  1705. 'REPETER' iidisc 3 ;
  1706. idisc = &iidisc ;
  1707. 'SI' ('EGA' idisc 1) ;
  1708.    tdisc = 'CHAINE' 'QUAF/LINM' ;
  1709.    ordvoul = 3. ;
  1710.    discg = 'QUAF' ;
  1711.    discv = 'QUAF' ;
  1712.    lvip  = 'MOTS' 'UR' 'UZ' ; 
  1713.    lvid  = 'MOTS' 'FR' 'FZ' ;
  1714.    discp = 'LINM' ;
  1715.    lpip  = 'MOTS' 'LX1'  'LX2'  'LX3' ; 
  1716.    lpid  = 'MOTS' 'LX1'  'LX2'  'LX3' ;
  1717.    'SI' complet ;   
  1718.       lisden = 'PROG' 0.5 0.25 0.125 0.0625 ;
  1719.    'SINON' ;      
  1720.       lisden = 'PROG' 0.5 0.25 0.125 ;
  1721.    'FINSI' ;      
  1722. 'FINSI' ;   
  1723. *
  1724. 'SI' ('EGA' idisc 2) ;
  1725.    tdisc = 'CHAINE' 'QUAD/LINE' ;
  1726.    ordvoul = 3. ;
  1727.    discg = 'QUAD' ;
  1728.    discv = 'QUAD' ;
  1729.    lvip  = 'MOTS' 'UR' 'UZ' ; 
  1730.    lvid  = 'MOTS' 'FR' 'FZ' ;
  1731.    discp = 'LINE' ;
  1732.    lpip  = 'MOTS' 'LXP' ; 
  1733.    lpid  = 'MOTS' 'LXP' ;
  1734.    'SI' complet ;
  1735.       lisden = 'PROG' 0.5 0.25 0.125 0.0625 ;
  1736.    'SINON' ;      
  1737.       lisden = 'PROG' 0.5 0.25 0.125 ;
  1738.    'FINSI' ;      
  1739. 'FINSI' ;   
  1740. *
  1741. 'SI' ('EGA' idisc 3) ;
  1742.    tdisc = 'CHAINE' 'LINC/CSTE' ;
  1743. * On devrait avoir 2. mais il faut raffiner !   
  1744.    ordvoul = 1.7 ;
  1745.    discg = 'LINE' ;
  1746.    discv = 'LINC' ;
  1747.    lvip  = 'MOTS' 'UR' 'UZ' ; 
  1748.    lvid  = 'MOTS' 'FR' 'FZ' ;
  1749.    discp = 'CSTE' ;
  1750.    lpip  = 'MOTS' 'LXP' ; 
  1751.    lpid  = 'MOTS' 'LXP' ;
  1752.    'SI' complet ;
  1753.       lisden = 'PROG' 0.5 0.25 0.125 0.0625 0.03125 ;
  1754.    'SINON' ;      
  1755.       lisden = 'PROG' 0.5 0.25 0.125 0.0625 ;
  1756.    'FINSI' ;      
  1757. 'FINSI' ;
  1758. *
  1759. nden = 'DIME' lisden ;
  1760. lh  = 'PROG' ; ll2 = 'PROG' ; lli = 'PROG' ; lst = 'PROG' ;
  1761. 'REPETER' iiden nden ;
  1762.    iden = &iiden ;
  1763.    den = 'EXTRAIRE' lisden iden ;
  1764. *   errl2 errli errfst = CALCUL imesh irig den VRAI ;
  1765.    errl2 errli errfst = CALCUL imesh irig den ;
  1766.    lh = APPEND lh den ; ll2 = APPEND ll2 errl2 ;
  1767.    lli = APPEND lli errli ; lst = APPEND lst errfst ;
  1768. 'FIN' iiden ;
  1769. *
  1770. lh ll2 lli lst = LOG10 lh ll2 lli lst ;
  1771. *
  1772. * Calcul des ordres de convergence
  1773. *
  1774. evl2 = 'EVOL' 'MANU' lh ll2 ;
  1775. cpl2 dummy = @POMI evl2 1 'IDEM' ;
  1776. ordl2 = cpl2 . 1 ;
  1777. tabevl2 . idisc = evl2 ;
  1778. tabtl2  . idisc = 'CHAINE' 'id=' idisc ';ord=' (formar ordl2 1) ;
  1779. *
  1780. * Test de l'ordre
  1781. *
  1782. test = 'EGA' ordl2 ordvoul ('*' ordvoul 0.2) ;
  1783. ok = ok 'ET' test ;
  1784. titcas = 'CHAINE' 'Maillage : ' tmesh ' Discretisation : ' tdisc ;
  1785. 'MESSAGE' titcas ;
  1786. 'MESSAGE' ('CHAINE' ' Ordre de convergence norme L2 axi sur la vitesse '
  1787.                     ordl2) ;
  1788. 'SI' ('NON' test) ;
  1789.    'MESSAGE' ('CHAINE' 'On aurait voulu avoir :' ordvoul) ;
  1790. 'FINSI' ;
  1791. evli = 'EVOL' 'MANU' lh lli ;
  1792. cpli dummy = @POMI evli 1 'IDEM' ;
  1793. ordli = cpli . 1 ;
  1794. tabevli . idisc = evli ;
  1795. tabtli  . idisc = 'CHAINE' 'id=' idisc ';ord=' (formar ordli 1) ;
  1796. evst = 'EVOL' 'MANU' lh lst ;
  1797. cpst dummy = @POMI evst 1 'IDEM' ;
  1798. ordst = cpst . 1 ;
  1799. tabevst . idisc = evst ;
  1800. tabtst  . idisc = 'CHAINE' 'id=' idisc ';ord=' (formar ordst 1) ;
  1801. 'FIN' iidisc ;
  1802. *
  1803. 'SI' graph ;
  1804. evtl2 = @STBL tabevl2 ;
  1805. tit = 'CHAINE' 'Ordre de convergence en norme L2 axi sur la vitesse' ;
  1806. tix = 'CHAINE' 'Log10 h' ;   
  1807. tiy = 'CHAINE' 'Log10 errl2' ;
  1808. DESSEVOL evtl2 tabtl2 tit tix tiy ;
  1809. *
  1810. evtli = @STBL tabevli ;
  1811. tit = 'CHAINE' 'Ordre de convergence en norme Linf sur la vitesse' ;
  1812. tix = 'CHAINE' 'Log10 h' ;   
  1813. tiy = 'CHAINE' 'Log10 errli' ;
  1814. DESSEVOL evtli tabtli tit tix tiy ;
  1815. *
  1816. evtst = @STBL tabevst ;
  1817. tit = 'CHAINE' 'Ordre de convergence sur la trainee de Stokes' ;
  1818. tix = 'CHAINE' 'Log10 h' ;   
  1819. tiy = 'CHAINE' 'Log10 errst' ;
  1820. DESSEVOL evtst tabtst tit tix tiy ;
  1821. 'FINSI' ;
  1822. 'FIN' iimesh ;
  1823. *
  1824. 'SI' ('NON' ok) ;
  1825.    'MESSAGE' ('CHAINE' 'Il y a eu des erreurs') ;
  1826.    'ERREUR' 5 ;
  1827. 'SINON' ;
  1828.    'MESSAGE' ('CHAINE' 'Tout sest bien passe !') ;
  1829. 'FINSI' ;
  1830. *
  1831. 'SI' interact ;
  1832.    'OPTION' 'DONN' 5 ;
  1833.    'OPTION' 'ECHO' 1 ;
  1834. 'FINSI' ;      
  1835. *
  1836. * End of dgibi file TRAINEE_2D
  1837. *
  1838. 'FIN' ;
  1839.  
  1840.  
  1841.  
  1842.  

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