Télécharger la plaquette Cast3M


fr en

Télécharger trainee_3d.dgibi

Retour à la liste

Numérotation des lignes : 

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

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