Télécharger g_theta.procedur

Retour à la liste

Numérotation des lignes :

  1. * G_THETA PROCEDUR FD218221 16/10/24 21:15:01 9134
  2. DEBPROC G_THETA SUPTAB*'TABLE';
  3. *|=====================================================================|
  4. *| |
  5. *| OBJECTIF : |
  6. *| ========== |
  7. *| |
  8. *| 1) calculer l'integrale caracteristique de mecanique de la rupture |
  9. *| a) J en elasto-plasticite ou en elasto-dynamique pour un |
  10. *| materiau isotrope. |
  11. *| b) dJ/da en elasto-plasticite, utilisable uniquement dans le cas |
  12. *| de materiau isotrope et homogene pour les elements massifs. |
  13. *| c) C* dans le cas de fluage secondaire stationnaire pour un |
  14. *| materiau isotrope. |
  15. *| d) C*H dans le cas de fluage primaire sous un chargement radial |
  16. *| pour un materiau isotrope. |
  17. *| |
  18. *| 2) separer les modes K1, K2 et K3 en elasticite, utilisable |
  19. *| uniquement dans le cas de materiau homogene et isotrope |
  20. *| pour les elements massifs. |
  21. *| |
  22. *| |
  23. *| ENTREE : |
  24. *| ======== |
  25. *| |
  26. *| SUPTAB objet de type TABLE. En entree, SUPTAB sert a definir les |
  27. *| options et les parametres du calcul. Ses indices sont des |
  28. *| objets de type MOTS (a ecrire en toutes lettres) dont voici |
  29. *| la liste : |
  30. *| |
  31. *| |
  32. *| Arguments obligatoires dans tous les cas |
  33. *| ---------------------------------------- |
  34. *| |
  35. *| SUPTAB.'OBJECTIF' = MOT pour preciser le but du calcul, vaut |
  36. *| 1) 'J' pour calculer l'integrale J (ou G), |
  37. *| caracteristique en elasto-plastique. |
  38. *| 2) 'J_DYNA' pour calculer l'integrale J (ou G), |
  39. *| caracteristique en elasto-dynamique. |
  40. *| 3) 'C*' pour calculer l'integrale C*, |
  41. *| caracteristique en fluage secondaire |
  42. *| stationnaire. |
  43. *| 4) 'C*H' pour calculer l'integrale C*(h), |
  44. *| caracteristique en fluage primaire ou |
  45. *| tertiaire. |
  46. *| 5) 'DJ/DA' pour calculer l'integrale de la |
  47. *| derivation dJ/da, caracteristique pour |
  48. *| analyser la stabilite de propagation d'une |
  49. *| fissure ou des fissures interagissantes. |
  50. *| 6) 'DECOUPLAGE' pour decouper les modes mixtes, |
  51. *| c'est a dire la separation des facteurs K1, |
  52. *| K2 (et K3 et 3D). |
  53. *| |
  54. *| SUPTAB.'COUCHE' = ENTIER representant le nombre de couches |
  55. *| d'elements autour du front de la fissure |
  56. *| qui se deplacent pour simuler la propagtion |
  57. *| de la fissure. Il vaut 0 si seul la pointe de |
  58. *| la fissure se deplace, 1 si c'est la premiere |
  59. *| couche d'elements entourant la fissure, 2 si |
  60. *| c'est l'ensemble des premiere et deuxieme couches |
  61. *| d'elements etc. Il convient veiller a ce que |
  62. *| l'ensemble des elements a deplacer n'atteint pas |
  63. *| le bord de la structure fissuree. |
  64. *| Cet argument doit etre absent si l'on souhaite |
  65. *| preciser soi-meme le CHAMP_THETA (cf.8.) |
  66. *| |
  67. *| SUPTAB.'FRONT_FISSURE' = POINT en 2D ou MAILLAGE en 3D massif |
  68. *| representant le front de la fissure. |
  69. *| |
  70. *| |
  71. *| Arguments obligatoires avec des elements standards |
  72. *| -------------------------------------------------- |
  73. *| |
  74. *| SUPTAB.'LEVRE_SUPERIEURE' = Selon la convention de definition, cet |
  75. *| objet (type MAILLAGE) representant la |
  76. *| levre superieure de la fissure. |
  77. *| |
  78. *| SUPTAB.'LEVRE_INFERIEURE' = Selon la convention de definition, cet |
  79. *| objet (type MAILLAGE) representant la |
  80. *| la levre inferieure de la fissure. Si |
  81. *| une seule levre est modelisee, un des |
  82. *| des deux mots ici (LEVRE_SUPERIEURE ou |
  83. *| LEVRE_INFERIEURE) sera suffisant pour |
  84. *| decrire la fissure. |
  85. *| |
  86. *| |
  87. *| Arguments obligatoires avec des elements enrichis (XFEM) |
  88. *| -------------------------------------------------------- |
  89. *| |
  90. *| SUPTAB.'PSI' = 1ere level set (CHPOINT) decrivant la fissure dans |
  91. *| le cas ou l'on utilise des elements XFEM . |
  92. *| SUPTAB.'PHI' = 2eme level set. |
  93. *| |
  94. *| |
  95. *| |
  96. *| Solution obligatoire issus de la procedure PASAPAS |
  97. *| -------------------------------------------------- |
  98. *| |
  99. *| SUPTAB.'SOLUTION_PASAPAS' = TABLE sortant de la procedure PASAPAS. |
  100. *| |
  101. *| |
  102. *| Solution obligatoire issus de l'operateur RESO |
  103. *| ---------------------------------------------- |
  104. *| |
  105. *| SUPTAB.'SOLUTION_RESO' = CHPOINT de deplacement issus de RESO. |
  106. *| SUPTAB.'CARACTERISTIQUES' = Champ de caractristiques matrielles |
  107. *| et eventuellement geometriques |
  108. *| si necessaire. |
  109. *| SUPTAB.'MODELE' = Objet modele (type MMODEL) englobant toute la |
  110. *| structure. |
  111. *| SUPTAB.'TEMPERATURES' = CHPOINT de temperature creant une contrainte|
  112. *| thermique non nulle si elle existe. |
  113. *| SUPTAB.'CHARGEMENTS_MECANIQUES' = CHPOINT representant l'ensemble |
  114. *| des forces exterieures |
  115. *| (surfaciques, volumiques ou |
  116. *| ponctuelles ....) appliquees sur |
  117. *| le systeme si elles existent, SAUF|
  118. *| la pression sur les levres de la |
  119. *| fissure |
  120. *| SUPTAB.'BLOCAGES_MECANIQUES' = RIGIDITE representant le blocages |
  121. *| mecanique du probleme, a fournir |
  122. *| uniquement dans le cas de calcul |
  123. *| de la derivation dJ/da. |
  124. *| |
  125. *| |
  126. *| Arguments optionnels |
  127. *| -------------------- |
  128. *| |
  129. *| |
  130. *| 1 : Materiaux composites (2D massif ou 3D coque seulement) |
  131. *| |
  132. *| SUPTAB.'MODELES_COMPOSITES' = TABLE indicee par des entiers (1 2... |
  133. *| M, M = nombre de Materiaux composites)|
  134. *| pour donner les modeles des materiaux |
  135. *| ayant des discontinutes de proprietes |
  136. *| materielles. |
  137. *| |
  138. *| 2 : Pour un front de fissure tridimensionnel massif |
  139. *| |
  140. *| SUPTAB.'NOEUDS_AVANCES' = MAILLAGE de type POI1 pour donner les |
  141. *| points du front pour lesquels le calcul |
  142. *| sera effectue. Si cet argument est |
  143. *| obsent, le calcul sera fait pour tous |
  144. *| les noeuds sur le front de la fissure. |
  145. *| |
  146. *| 3 : Calcul des termes croises de la matrice dJi/daj |
  147. *| (i non egal a j) dans le cas des fisures interagissantes. |
  148. *| |
  149. *| SUPTAB.'FISSURE_2' = Objet de type MAILLAGE representant une autre |
  150. *| fissure (levres superieure + inferieure si |
  151. *| toutes les deux levres sont presentes). |
  152. *| SUPTAB.'FRONT_FISSURE_2' = POINT ou MAILLAGE reprsentant le front |
  153. *| de la fissure 2 decrite ci-dessus. |
  154. *| |
  155. *| |
  156. *| 4 : Cas d'une fissure circulaire dans une geometrie plane |
  157. *| |
  158. *| SUPTAB.'POINT_CENTRE' = centre de la fissure circulaire |
  159. *| |
  160. *| 5 : Cas ou l'extension de la fissure correspond a une simple |
  161. *| translation dans un tuyauterie droite (3D). Dans ce cas |
  162. *| on effectue dans la procedure CH_THETA une transformation |
  163. *| de tuyau en plaque en passant au systeme de coordonnees |
  164. *| cylindriques. Il est alors necessaire de fournir : |
  165. *| |
  166. *| SUPTAB.'POINT_1' = centre du systeme de coordonnees |
  167. *| SUPTAB.'POINT_2' = POINT tel que l'axe defini par POINT_1 |
  168. *| vers POINT_2 soit l'axe Z poisitif |
  169. *| SUPTAB.'POINT_3' = POINT tel que le plan defini par les 3 points |
  170. *| POINT_1 POINT_2 POINT_3 donne l'angle theta nul |
  171. *| |
  172. *| 6 : Cas ou l'extension de la fissure ne correspond |
  173. *| pas a une simple translation (3D) |
  174. *| |
  175. *| 6.1 Fissure dans un tuyauterie droite (3D, Rotation) |
  176. *| |
  177. *| SUPTAB.'POINT_1' = Objet de type POINT |
  178. *| SUPTAB.'POINT_2' = Objet de type POINT qui, avec le point POINT_1, |
  179. *| constitue l'axe perpendiculaire a la section |
  180. *| fissuree. |
  181. *| |
  182. *| 6.2 Fissure dans un coude (3D, rotation + transformation) |
  183. *| Outre les deux points SUPTAB.'POINT_1' et SUPTAB.'POINT_2' |
  184. *| definis en haut on donne encore : |
  185. *| |
  186. *| SUPTAB.'CHPOINT_TRANSFORMATION' = Objet de type CHPOINT utilise |
  187. *| pour transformer une coude en un |
  188. *| tuyauterie droite. |
  189. *| SUPTAB.'OPERATEUR' = Objet de type MOT valant 'PLUS' ou 'MOIN' pour |
  190. *| indiquer l'operateur PLUS ou MOIN a utiliser |
  191. *| si l'on veut transformer la coude en un |
  192. *| tuyauterie droite. |
  193. *| |
  194. *| 7 : Rotation rigidifiante imposee dans le calcul par PASAPAS |
  195. *| |
  196. *| SUPTAB.'ROTATION_RIGIDIFIANTE' = table indicee par entiers 0,1,2... |
  197. *| donnant les champs de deplacements |
  198. *| due a une rotation rigidifiante de |
  199. *| la piece autour d'un point. Cette |
  200. *| rotation rigidifiante est imposee |
  201. *| dans le calcul par PASAPAS en tant |
  202. *| d'un calcul en grand deplacement. |
  203. *| |
  204. *| 8 : Cas ou on souhaite donner soi-meme le champ THETA |
  205. *| |
  206. *| SUPTAB.'CHAMP_THETA' = Objet de type CHPOINT caracterisant la |
  207. *| propagation de la fissure. Dans ce cas, |
  208. *| ne pas fournir l'indice 'COUCHE' de SUPTAB, |
  209. *| mais fournir 'CHAMP_THETA' a chaque appel. |
  210. *| |
  211. *| 9 : Cas ou on souhaite calculer une integrale dans l epaisseur |
  212. *| d une structure en coque (rapport DMT/96-317) |
  213. *| |
  214. *| On utilise pour cela la technique de multicouche, qui |
  215. *| consiste, avant d'appeler la proceduer G_THETA, a : |
  216. *| 1) Etablir un modele multicouches (cf MODE CONS) sur un ou |
  217. *| des element(s) proche(s) de la fissure sachant qu'il faut |
  218. *| au moins une couche en peau inferieure, une couche en |
  219. *| peau superieure, une couche en ligne moyenne {ces couches |
  220. *| doivent avoir une epaisseur inferieure a 1e-4*(epaisseur |
  221. *| totale de la coque) et donc 2 couches intermediaires. |
  222. *| 2) Penser a donner un excentrement et un nom constituant |
  223. *| different a ces couches. |
  224. *| 3) Assembler le modele multicouches avec le modele du reste |
  225. *| de la structure. |
  226. *| 4) Effectuer le calcul des contraintes et des deplacements |
  227. *| avec le modele total et le materiau qui en decoule. |
  228. *| Le calcul de l'integrale avec la procedure G_THETA sera |
  229. *| realise sur un seul element en multicouche et pour toutes les|
  230. *| couches dans cet element qui ont une epaisseur inferieure a |
  231. *| 1e-4*(epaisseur totale de la coque). Un tel element doit |
  232. *| etre designe par l'argument suivant : |
  233. *| |
  234. *| SUPTAB.'ELEMENT_MULTICOUCHE' = Objet MAILLAGE comportant UN SEUL |
  235. *| element modelise en multicouche. Il |
  236. *| doit etre a l'interieur de la zone |
  237. *| THETA, c'est a dire dans la zone |
  238. *| definie par le nombre SUPTAB.'COUCHE'.
  239. *| Il ne doit pas etre trop loin, ni |
  240. *| trop proche de la pointe de la |
  241. *| fissure. Theoriquement, l'integrale |
  242. *| a calculer est independant du choix |
  243. *| de l'element pres de la fissure, ce |
  244. *| qui est numeriquement verifiable en |
  245. *| la determinant sur des elemens en |
  246. *| multicouche differents. NOTA : Cette |
  247. *| technique necessite un maillage tres |
  248. *| fin dans la zone de la pointe de la |
  249. *| fissure. |
  250. *| |
  251. *| |
  252. *| SORTIE : |
  253. *| ======== |
  254. *| |
  255. *| Les resultats du calcul correspondant a un champ THETA specifie par |
  256. *| l'objet SUPTAB.'COUCHE' (ou SUPTAB.'CHAMP_THETA' dans le cas ou on |
  257. *| souhaite donner soi-meme un champ de type Theta) sont sauves de la |
  258. *| maniere suivante : |
  259. *| |
  260. *| |
  261. *| Dans tous les cas de calcul |
  262. *| --------------------------- |
  263. *| |
  264. *| SUPTAB.'RESULTATS' = Objet contenant la valeur numerique du calcul. |
  265. *| Son type est variable selon qu'on est en 2D ou |
  266. *| 3D et selon la solution du probleme traite : |
  267. *| |
  268. *| 1) valeur de l'integrale de contour dans le cas|
  269. *| d'une solution provenant de l'operateur RESO|
  270. *| 2D => FLOTTANT |
  271. *| 3D massif => TABLE indicee par |
  272. *| .(points au front de fissure) |
  273. *| .'GLOBAL' pour une estimation globale |
  274. *| 3D coque => TABLE indicee par mots |
  275. *| .'SUPERI' en peau superieure |
  276. *| .'INFERI' en peau inferieure |
  277. *| .'MEDIAN' au plan median et |
  278. *| .'GLOBAL' pour une estimation globale |
  279. *| |
  280. *| 2) valeur de l'integrale de contour a un |
  281. *| certain pas du calcul dans le cas d'une |
  282. *| solution provenant de la procedure PASAPAS |
  283. *| 2D => TABLE indicee par |
  284. *| .(numero du pas de calcul) |
  285. *| 3D massif => TABLE indicees par |
  286. *| .(numero du pas de calcul).(points au |
  287. *| front de fissure) |
  288. *| 3D coque => TABLE indicees |
  289. *| .(numero du pas de calcul).'SUPERI' |
  290. *| .(numero du pas de calcul).'INFERI' |
  291. *| .(numero du pas de calcul).'MEDIAN' et |
  292. *| .(numero du pas de calcul).'GLOBAL' |
  293. *| |
  294. *| 3) valeur des F.I.C. (facteurs d'intensite des |
  295. *| contraintes) dans le cas de decouplage des |
  296. *| modes avec une solution provenant de |
  297. *| l'operateur RESO |
  298. *| 2D => TABLE indicee par mots |
  299. *| .'I' pour KI |
  300. *| .'II' pour KII |
  301. *| 3D massif => TABLE indicees par |
  302. *| .'I' .(points au front de fissure) |
  303. *| pour KI |
  304. *| .'II' .(points au front de fissure) |
  305. *| pour KII |
  306. *| .'III'.(points au front de fissure) |
  307. *| pour KIII et |
  308. *| .'GLOBAL'.(points au front de fissure) |
  309. *| |
  310. *| 4) valeur des F.I.C. (facteurs d'intensite des |
  311. *| contraintes) a un certain pas du calcul |
  312. *| dans le cas de decouplage des modes avec |
  313. *| une solution provenant de la procedure |
  314. *| PASAPAS |
  315. *| 2D => TABLE indicees |
  316. *| .'I' .(numero du pas de calcul) pour KI |
  317. *| .'II'.(numero du pas de calcul) pour KII |
  318. *| 3D massif => TABLE indicees par |
  319. *| .'I' .(numero du pas de calcul).(point |
  320. *| au front de fissure) pour KI |
  321. *| .'II' .(numero du pas de calcul).(points |
  322. *| au front de fissure) pour KII |
  323. *| .'III'.(numero du pas de calcul).(points |
  324. *| au front de fissure) pour KIII |
  325. *| |
  326. *| |
  327. *| Dans le cas de calcul effectue pas a pas |
  328. *| ---------------------------------------- |
  329. *| |
  330. *| SUPTAB.'EVOLUTION_RESULTATS' = Objet contenant l'evolution des |
  331. *| resultats en fonction du temps. |
  332. *| Son type est variable selon la |
  333. *| configuration du probleme traite : |
  334. *| |
  335. *| 1) Evolution de l'integrale de contour |
  336. *| 2D => EVOLUTION |
  337. *| 3D massif => TABLE indicee par |
  338. *| .(points au front de fissure) |
  339. *| .'GLOBAL' evolution pour une |
  340. *| estimation globale |
  341. *| 3D coque => TABLE indicee par mots |
  342. *| .'SUPERI' en peau superieure |
  343. *| .'INFERI' en peau inferieure |
  344. *| .'MEDIAN' au plan median et |
  345. *| .'GLOBAL' evolution pour une |
  346. *| estimation globale |
  347. *| |
  348. *| 2) Evolution des F.I.C. (facteurs |
  349. *| d'intensite de contrainte) |
  350. *| 2D => TABLE indicee par |
  351. *| .'I' pour KI |
  352. *| .'II' pour KII |
  353. *| 3D massif => TABLE indicee par |
  354. *| .'I'. (points au front de fissure)
  355. *| .'II'. (points au front de fissure)
  356. *| .'III'.(points au front de fissure)
  357. *| .'GLOBAL' evolution pour une |
  358. *| estimation globale |
  359. *| |
  360. *| |
  361. *| Dans le cas des elements de coque |
  362. *| --------------------------------- |
  363. *| |
  364. *| SUPTAB.'EPAISSEUR_RESULTATS' = representant l'evolution de la valeur|
  365. *| des integrales dans l'epaisseur de la|
  366. *| coque. Son type est variable selon la|
  367. *| solution du probleme traite : |
  368. *| 1) EVOLUTION dans le cas d'une solution |
  369. *| provenant de l'operateur RESO |
  370. *| 2) TABLE indicee par .(numero du pas de |
  371. *| calcul) dans le cas d'une solution |
  372. *| provenant de la procedure PASAPAS |
  373. *| |
  374. *| |
  375. *| Dans le cas de calcul elasto-plastique |
  376. *| -------------------------------------- |
  377. *| |
  378. *| SUPTAB.'CRITERE_DECHARGE' = En cas de calcul elasto-plastique |
  379. *| isotrope ou cinematique, eventuellement thermique, on |
  380. *| calcul un critere de decharge des contraintes defini par |
  381. *| (si, F = courbe de traction ): crit = F(EPSeq)/ SIGeq. |
  382. *| crit = 1. si non-decharge et crit > 1. si decharge. |
  383. *| SUPTAB.'CRITERE_DECHARGE' est une table indicee par les |
  384. *| temps de calcul. |
  385. *| |
  386. *| |
  387. *| Dans le cas du contact frottement sur les levres |
  388. *| -------------------------------------- |
  389. *| |
  390. *| A ce jour, cela est traite pour le cas xfem (these de B.Trolle). |
  391. *| |
  392. *|=====================================================================|
  393. fltrac = faux ;
  394. * fltrac = VRAI ;
  395. flmess = VRAI ;
  396. TRA_PRES = FAUX;
  397. si(flmess);
  398. SAUT LIGN; mess '------------------'
  399. 'DEBUT DE LA PROCEDURE G_THETA' '--------------------';
  400. finsi;
  401. **************************************************
  402. ************* INFORMATIONS GENERALES *************
  403. **************************************************
  404. SAUT 1 'LIGNE'; VALPI = PI;
  405. &ELEM = VALE 'ELEM'; MOTAX = MOT 'AXIS' ;
  406. CONFIG0 = FORM;
  407.  
  408.  
  409. **************************************************
  410. *** QUELQUES MOTS POUR SIMPLIFIER L'ECRITURE ***
  411. **************************************************
  412. MTS1 = MOTS 'SCAL';
  413. MU1 = MOT 'UX'; MU2 = MOT 'UY'; MU3 = MOT 'UZ';
  414. MF1 = MOT 'FX'; MF2 = MOT 'FY'; MF3 = MOT 'FZ';
  415. SI (EGA MOTAX &MODE) ;
  416. MU1 = MOT 'UR'; MU2 = MOT 'UZ'; MU3 = MOT 'UT';
  417. MF1 = MOT 'FR'; MF2 = MOT 'FZ';
  418. FINSI;
  419. *listmots
  420. SI (EGA &DIME 2);
  421. * cas axis : faut-il ajouter mu3 ?
  422. MU123 = mots MU1 MU2;
  423. MF123 = mots MF1 MF2;
  424. MV123 = mots 'VX' 'VY';
  425. SINO;
  426. MU123 = mots MU1 MU2 MU3;
  427. MF123 = mots MF1 MF2 MF3;
  428. MV123 = mots 'VX' 'VY' 'VZ';
  429. FINS;
  430.  
  431. **************************************************
  432. ***** DONNEES OBLIGATOIRES DANS TOUS LES CAS *****
  433. **************************************************
  434. SI (NON (EXIS SUPTAB 'OBJECTIF'));
  435. MESS 'ERREUR :IL FAUT SPECIFIER L INTEGRALE';
  436. MESS ' A CALCULER PAR UN MOT';
  437. ERRE 21; QUIT G_THETA;
  438. SINON;
  439. IINTE = 0;
  440. SI (EGA SUPTAB.'OBJECTIF' 'J');
  441. IINTE = 1;
  442. FINSI;
  443. SI (EGA SUPTAB.'OBJECTIF' 'C*');
  444. IINTE = 2;
  445. FINSI;
  446. SI (EGA SUPTAB.'OBJECTIF' 'C*H');
  447. IINTE = 3;
  448. FINSI;
  449. SI (EGA SUPTAB.'OBJECTIF' 'DJ/DA');
  450. IINTE = 4;
  451. FINSI;
  452. SI (EGA SUPTAB.'OBJECTIF' 'J_DYNA');
  453. IINTE = 5;
  454. FINSI;
  455. SI (EGA SUPTAB.'OBJECTIF' 'DECOUPLAGE');
  456. IINTE = 99;
  457. FINSI;
  458. SI (EGA IINTE 0);
  459. MESS 'ERREUR : ON NE CONNAIT PAS L INTEGRALE SPECIFIEE';
  460. MESS ' A CALCULER';
  461. ERRE 21; QUIT G_THETA;
  462. FINSI;
  463. FINSI;
  464. SI (NON (EXIS SUPTAB 'FRONT_FISSURE'));
  465. MESS 'ERREUR : ON VEUT LE FRONT DE LA FISSURE';
  466. ERRE 21; QUIT G_THETA;
  467. FINSI;
  468. MESHFR1 = SUPTAB . 'FRONT_FISSURE';
  469. SI(EGA (TYPE MESHFR1) 'POINT');
  470. MESHFR1 = MANU 'POI1' MESHFR1;
  471. FINSI;
  472. MESHFR1 = MESHFR1 COUL 'OLIV';
  473.  
  474. **************************************************
  475. ****** TERMES CROISES DE LA MATRICE dJi/daj ******
  476. **************************************************
  477. SI (EGA IINTE 4);
  478. SI ((EXIS SUPTAB 'FISSURE_2') OU
  479. (EXIS SUPTAB 'FRONT_FISSURE_2'));
  480. SI (NON (EXIS SUPTAB 'FISSURE_2'));
  481. MESS 'ERREUR : ON VEUT AUSSI LA FISSURE 2 POUR CALCULER';
  482. MESS ' LES TERMES CROISES DE LA MATRICE';
  483. ERRE 21; QUIT G_THETA;
  484. FINSI;
  485. SI (NON (EXIS SUPTAB 'FRONT_FISSURE_2'));
  486. MESS 'ERREUR : ON VEUT AUSSI LE FROND DE LA FISSURE 2 POUR';
  487. MESS ' CALCULER LES TERMES CROISES DE LA MATRICE';
  488. ERRE 21; QUIT G_THETA;
  489. FINSI;
  490. SINON;
  491. SI (EGA SUPTAB.'COUCHE' 0);
  492. MESS 'ERREUR : LE NOMBRE DE COUCHES DOIT ETRE SUPERIEUR A';
  493. MESS ' 0 POUR LE CALCUL DU TERME PRINCIPAL DJi/DAi';
  494. ERRE 21; QUIT G_THETA;
  495. FINSI;
  496. FINSI;
  497. FINSI;
  498.  
  499. **************************************************
  500. ****** DONNEES EN CAS DE CALCUL NONLINEAIRE ******
  501. **************************************************
  502. *
  503. *initialisation des valeurs par defaut************
  504. IPAP = MOT 'NONDEFINI';
  505. IGDEP = FAUX;
  506. IGDER = FAUX;
  507. IPERSO1 = FAUX;
  508. IMOPRES = FAUX;
  509. IPFISS = FAUX;
  510.  
  511. SI (EXIS SUPTAB 'SOLUTION_PASAPAS');
  512. IPAP = VRAI;
  513. * recup du modele mecanique et du materiau associe depuis WTABLE ****
  514. SI (EXIS SUPTAB.'SOLUTION_PASAPAS' 'WTABLE');
  515. WTAB=SUPTAB.'SOLUTION_PASAPAS'.'WTABLE';
  516. OBJMOD=WTAB.'MOD_MEC';
  517. OBJMAT=WTAB.'MAT_MEC';
  518. SI (EGA IINTE 5);
  519. SI (NON WTAB.'DYNAMIQUE');
  520. MESS 'ERREUR : IL FAUT UNE SOLUTION ELASTO-DYNAMIQUE';
  521. MESS ' POUR CALCULER LE J DYNAMIQUE.';
  522. ERRE 21; QUIT G_THETA;
  523. FINSI;
  524. FINSI;
  525. * recup du model et du materiau depuis SOLUTION_PASAPAS ****
  526. * rem BP: on ne devrait jamais passer par ici ...
  527. SINON;
  528. MESS 'Absence de WTABLE ! l execution continue ...';
  529. * on reduit le modele et le materiau au seul comportement mecanique
  530. OBJMOD = EXTR (SUPTAB.'SOLUTION_PASAPAS'.'MODELE')
  531. 'FORM' 'MECANIQUE';
  532. OBJMAT = REDU (SUPTAB.'SOLUTION_PASAPAS'.'CARACTERISTIQUES') OBJMOD;
  533. SI (EGA IINTE 5);
  534. SI (NON SUPTAB.'SOLUTION_PASAPAS'.'DYNAMIQUE');
  535. MESS 'ERREUR : IL FAUT UNE SOLUTION ELASTO-DYNAMIQUE';
  536. MESS ' POUR CALCULER LE J DYNAMIQUE.';
  537. ERRE 21; QUIT G_THETA;
  538. FINSI;
  539. FINSI;
  540. WTAB= SUPTAB.'SOLUTION_PASAPAS';
  541. FINSI;
  542. SUPTAB . 'MODELE' = OBJMOD;
  543. * recuperation des modeles de pression
  544. SI (EXIS (SUPTAB.'SOLUTION_PASAPAS'.'MODELE') 'FORM' 'CHARGEMENT');
  545. MODCHA = EXTR (SUPTAB.'SOLUTION_PASAPAS'.'MODELE')
  546. 'FORM' 'CHARGEMENT';
  547. SI (EXIS MODCHA 'MATE' 'PRESSION');
  548. IMOPRES = VRAI;
  549. MODPRE = EXTR MODCHA 'COMP' 'PRESSION';
  550. FINSI;
  551. FINSI;
  552. SI WTAB.'GRANDS_DEPLACEMENTS';
  553. IGDEP = VRAI;
  554. FINSI;
  555. SI (EXIS SUPTAB 'ROTATION_RIGIDIFIANTE');
  556. IGDER = VRAI;
  557. FINSI;
  558. * cas particulier de perso1 ou l on ne calcule que ****
  559. * le dernier pas de temps (contenu dans la table estim)
  560. SI (EXIS SUPTAB 'PERSO1');
  561. IPERSO1 = SUPTAB . 'PERSO1';
  562. si(flmess); mess 'utilisation de PERSO1 en cours de dvlpt'; finsi;
  563. SI (EXIS SUPTAB.'SOLUTION_PASAPAS' 'ESTIMATION');
  564. ESTIM = SUPTAB . 'SOLUTION_PASAPAS' . 'ESTIMATION';
  565. SINON;
  566. MESS 'ERREUR : il faut une ESTIMATION dans la SOLUTION_PASAPAS';
  567. ERRE 21; QUIT G_THETA;
  568. FINSI;
  569. SI (NON (EXIS SUPTAB 'MAILLAGE_REDUIT'));
  570. MESS 'Attention! utilisation de PERSO1 sans MAILLAGE_REDUIT';
  571. MESS 'uniquement valable dans le cas de fissure stationnaire';
  572. FINSI;
  573. FINSI;
  574. FINSI;
  575.  
  576.  
  577. **************************************************
  578. ******** DONNEES EN CAS DE CALCUL LINEAIRE *******
  579. **************************************************
  580. SI (EXIS SUPTAB 'SOLUTION_RESO');
  581. SI (EGA (TYPE SUPTAB.'SOLUTION_RESO') 'CHPOINT ');
  582. IPAP = FAUX;
  583. SI ((EGA IINTE 2) OU (EGA IINTE 3));
  584. MESS 'ERREUR : C* OU C*H EST UNE INTEGRALE';
  585. MESS ' CARACTERISTIQUE EN FLUAGE';
  586. ERRE 21; QUIT G_THETA;
  587. FINSI;
  588. SI (EGA IINTE 5);
  589. MESS 'ERREUR : IL FAUT UNE SOLUTION DE LA PROCEDURE PASAPAS';
  590. MESS ' POUR CALCULER LE J EN ELASTO-DYNAMIQUE.';
  591. ERRE 21; QUIT G_THETA;
  592. FINSI;
  593. SI (NON (EXIS SUPTAB 'CARACTERISTIQUES'));
  594. MESS 'ERREUR : IL FAUT DONNER LE CHAMP CARACTERISTIQUE';
  595. ERRE 21; QUIT G_THETA;
  596. FINSI;
  597. SI (NON (EXIS SUPTAB 'MODELE'));
  598. MESS 'ERREUR : IL FAUT DONNER LE MODELE DE CALCUL';
  599. ERRE 21; QUIT G_THETA;
  600. FINSI;
  601. OBJMOD = EXTR (SUPTAB.'MODELE') 'FORM' 'MECANIQUE';
  602. OBJMAT = REDU (SUPTAB.'CARACTERISTIQUES') OBJMOD;
  603. SI (EXIS (SUPTAB.'MODELE') 'FORM' 'CHARGEMENT');
  604. MODCHA = EXTR (SUPTAB.'MODELE') 'FORM' 'CHARGEMENT';
  605. SI (EXIS MODCHA 'MATE' 'PRESSION');
  606. IMOPRES = VRAI;
  607. MODPRE = EXTR MODCHA 'COMP' 'PRESSION';
  608. MATPRE = REDU (SUPTAB.'CARACTERISTIQUES') MODPRE;
  609. FINSI;
  610. FINSI;
  611. SI ((NON (EXIS SUPTAB 'TEMPERATURES')) ET
  612. (NON (EXIS SUPTAB 'CHARGEMENTS_MECANIQUES')) ET
  613. (NON IMOPRES));
  614. MESS 'ERREUR : IL FAUT LES CHARGEMENTS APPLIQUES :';
  615. MESS ' MECANIQUES, THERMIQUES OU LES DEUX';
  616. ERRE 21; QUIT G_THETA;
  617. FINSI;
  618. SI ((EGA IINTE 4) ET
  619. (NON (EXIS SUPTAB 'BLOCAGES_MECANIQUES')));
  620. MESS 'ERREUR : IL FAUT DONNER LE BLOCAGES MECANIQUES';
  621. ERRE 21; QUIT G_THETA;
  622. FINSI;
  623. FINSI;
  624. FINSI;
  625. SI (EGA (TYPE IPAP) 'MOT ');
  626. MESS 'ERREUR : IL FAUT UNE SOLUTION PROVENANT DE PASAPAS';
  627. MESS ' OU DE RESO POUR DETERMINER L INTEGRALE';
  628. ERRE 641; QUIT G_THETA;
  629. FINSI;
  630.  
  631.  
  632. **************************************************
  633. ***** DONNEES EN CAS DE CHARGEMENT THERMIQUE *****
  634. **************************************************
  635. SI IPAP;
  636. CHAR1 = SUPTAB.'SOLUTION_PASAPAS'.'CHARGEMENT';
  637. * ITHER = EXIS CHAR1 'T ';
  638. *bp, 2014-11-13 : ajout distinction cas ITHER et ITHER1
  639. * ITHER=V ITHER1=F <=> pb couples thermo-mecaniques
  640. ITHER1 = (EXIS CHAR1 'T ') ou (EXIS CHAR1 'TIMP');
  641. ITHER = ITHER1 ou (EXIS CHAR1 'Q ')
  642. ou (EXIS CHAR1 'TECO') ou (EXIS CHAR1 'TERA');
  643. SI ITHER;
  644. TALPH1 = WTAB.'TALPHA_REFERENCE';
  645. FINSI;
  646. SINON;
  647. ITHER = EXIS SUPTAB 'TEMPERATURES';
  648. FINSI;
  649.  
  650. **************************************************************
  651. ***** DONNEES EN CAS DE CHARGEMENT DEFORMATIONS IMPOSEES *****
  652. **************************************************************
  653. SI IPAP;
  654. IDEFI = EXIS CHAR1 'DEFI';
  655. SINON;
  656. IDEFI = EXIS SUPTAB 'DEFORMATIONS_IMPOSEES';
  657. FINSI;
  658.  
  659. **************************************************
  660. ***** DONNEES EN CAS DE CONTACT (ajout BP BT) ****
  661. **************************************************
  662. IFROT=faux;
  663. SI IPAP;
  664. * todo : pas developpe pour l'instant
  665. SINON;
  666. SI (exis SUPTAB 'MODELE_FISSURE');
  667. IFROT = vrai;
  668. OBJCON = SUPTAB . 'MODELE_FISSURE';
  669. MAICON = extr OBJCON 'MAILLAGE';
  670. FINS;
  671. FINSI;
  672.  
  673. **************************************************
  674. ******* TYPE DES ELEMENTS : COQUE OU MASSIF ******
  675. **************************************************
  676. * IPLAN = (EGA &ELEM 'TRI3') OU (EGA &ELEM 'QUA4') OU
  677. * (EGA &ELEM 'TRI6') OU (EGA &ELEM 'QUA8');
  678. *bp: pas tres robuste => on remplace par :
  679. MAILLAGE = EXTR OBJMOD 'MAIL' ;
  680. LELEM1 = MAILLAGE ELEM 'TYPE' ;
  681. IPLAN = (EXIS LELEM1 'TRI3') OU (EXIS LELEM1 'QUA4') OU
  682. (EXIS LELEM1 'TRI6') OU (EXIS LELEM1 'QUA8');
  683. ICOQU = (&DIME EGA 3) ET IPLAN;
  684.  
  685. **************************************************
  686. **** MODELE MULTICOUCHES DANS LE CAS DE COQUE ****
  687. **************************************************
  688. SI ICOQU;
  689. M_DETA = EXTR OBJMOD 'ZONE';
  690. SI (EXIS SUPTAB 'ELEMENT_MULTICOUCHE');
  691. ELMULT = SUPTAB.'ELEMENT_MULTICOUCHE';
  692. SI (NEG (TYPE ELMULT) 'MAILLAGE');
  693. MESS 'ERREUR : L ELEMENT EN MULTICOUCHE DOIT';
  694. MESS ' ETRE UN OBJET DE TYPE MAILLAGE';
  695. ERRE 21; QUIT G_THETA;
  696. FINSI;
  697. SI (NEG (NBEL ELMULT) 1);
  698. MESS 'ERREUR : ON VEUT UN SEUL ELEMENT EN MULTICOUCHE';
  699. ERRE 21; QUIT G_THETA;
  700. FINSI;
  701. SINON;
  702. MESS 'ERREUR : IL FAUT DESIGNER UN ELEMENT EN MULTICOUCHE';
  703. ERRE 21; QUIT G_THETA;
  704. FINSI;
  705. M_ELMU = EXTR (REDU OBJMOD ELMULT) 'ZONE';
  706. SI ((DIME M_ELMU) '<' 10);
  707. MESS 'ERREUR : IL FAUT AU MOINS 3 COUCHES (peau inf, peau';
  708. MESS ' sup, ligne moyenne) D EPAISSEUR INFERIEURE';
  709. MESS ' A 1E-4*(EPAISSEUR TOTALE) + 2 COUCHES';
  710. MESS ' INTERMEDIAIRES POUR L ELEMENT DESIGNE EN';
  711. MESS ' MULTICOUCHE PROCHE DE LA FISSURE.';
  712. ERRE 21; QUIT G_THETA;
  713. FINSI;
  714. PEX1 = PROG; LMO1 = LECT; MODCOU = TABLE; EPAITO = 0.;
  715. REPETER NBJ5 ((DIME M_ELMU)/2);
  716. I1 = (2 * &NBJ5) - 1;
  717. MODCOU.&NBJ5 = M_ELMU.I1;
  718. EX1 = EXTR (REDU MODCOU.&NBJ5 OBJMAT) 'EXCE' 1 1 1;
  719. EP1 = EXTR (REDU MODCOU.&NBJ5 OBJMAT) 'EPAI' 1 1 1;
  720. EPAITO = EPAITO + EP1;
  721. PEX1 = PEX1 ET (PROG EX1);
  722. LMO1 = LMO1 ET (LECT &NBJ5);
  723. FIN NBJ5;
  724. NSUPE = 0; NMOYE = 0; NINFE = 0;
  725. REPETER NBJ6 (DIME MODCOU);
  726. EX1 = EXTR PEX1 &NBJ6;
  727. LM1 = EXTR LMO1 &NBJ6;
  728. SI (EGA EX1 (EPAITO/2.) 1.E-4); NSUPE = LM1; FINSI;
  729. SI (EGA EX1 0. 1.E-10); NMOYE = LM1; FINSI;
  730. SI (EGA EX1 (EPAITO/(-2.)) 1.E-4); NINFE = LM1; FINSI;
  731. FIN NBJ6;
  732. SI (EGA NSUPE 0);
  733. MESS 'ERREUR : IL FAUT UNE COUCHE EN PEAU SUPERIEURE';
  734. MESS ' D EPAISSEUR INFERIEURE A';
  735. MESS ' 1E-4*(EPAISSEUR TOTALE) ';
  736. ERRE 21; QUIT G_THETA;
  737. FINSI;
  738. SI (EGA NMOYE 0);
  739. MESS 'ERREUR : IL FAUT UNE COUCHE AU PLAN MEDIAN';
  740. MESS ' AYANT UN EXCENTREMENT NUL';
  741. ERRE 21; QUIT G_THETA;
  742. FINSI;
  743. SI (EGA NINFE 0);
  744. MESS 'ERREUR : IL FAUT UNE COUCHE EN PEAU INFERIEURE';
  745. MESS ' D EPAISSEUR INFERIEURE A';
  746. MESS ' 1E-4*(EPAISSEUR TOTALE) ';
  747. ERRE 21; QUIT G_THETA;
  748. FINSI;
  749. SUPTAB.'EPAISSEUR' = EPAITO;
  750. M_SUPE = MODCOU.NSUPE;
  751. M_MOYE = MODCOU.NMOYE;
  752. M_INFE = MODCOU.NINFE;
  753. FINSI;
  754.  
  755. **************************************************
  756. ** MAILLAGE UTILISE DANS LA RESOLUTION PAR E.F. **
  757. **************************************************
  758. * MAILLAGE = EXTR OBJMOD 'MAIL' ;
  759. * -> bp:fait + haut
  760. SI ICOQU;
  761. TMULT = TABLE;
  762. REPETER NBJ8 ((DIME M_DETA)/2);
  763. M1 = M_DETA.(2*&NBJ8);
  764. SI (EXIS TMULT M1);
  765. ITER NBJ8;
  766. FINSI;
  767. M2 = EXTR (REDU OBJMOD M1) 'ZONE';
  768. SI ('>' (DIME M2) 2);
  769. TMULT.M1 = VRAI;
  770. REPETER NBJ9 (((DIME M2)/2) - 1);
  771. MAILLAGE = DIFF MAILLAGE M1;
  772. FIN NBJ9;
  773. FINSI;
  774. FIN NBJ8;
  775. FINSI;
  776. SUPTAB.'MAILLAGE' = MAILLAGE;
  777.  
  778. **************************************************
  779. *************** TYPES D ELEMENTS ****************
  780. **************************************************
  781.  
  782. ******* ELEMENTS LINEAIRES OU NONLINEAIRES *******
  783. NBNO1 = NBNO (ELEM (CHAN 'LIGNE' MAILLAGE) 1);
  784. ILIN = EGA NBNO1 2; IQUA = EGA NBNO1 3;
  785.  
  786. ******* ELEMENTS XFEM OU STANDARD ****************
  787. IXFEM = EXIS OBJMOD 'ELEM' 'XQ4R' 'XC8R';
  788.  
  789. **************************************************
  790. ************* DEFINITON DE LA FISSURE ************
  791. **************************************************
  792.  
  793. ******* LEVELSET PSI ET PHI POUR XFEM ************
  794. SI(IXFEM);
  795. SI ((EXIS SUPTAB 'PSI') et (EXIS SUPTAB 'PHI'));
  796. PSI0 = SUPTAB . 'PSI';
  797. PHI0 = SUPTAB . 'PHI';
  798. SINO;
  799. MESS 'ERREUR : ON VEUT PSI et PHI LEVELSET DE LA FISSURE';
  800. ERRE 641; QUIT G_THETA;
  801. FINSI;
  802.  
  803. ******* LEVRE_SUPERIEURE ET INFERIEURE POUR STD ***
  804. SINO;
  805. SI (NON (EXIS SUPTAB 'LEVRE_SUPERIEURE'));
  806. SI (EGA IINTE 99);
  807. MESS 'ERREUR : ON VEUT LA LEVRE SUPERIEURE DE LA FISSURE';
  808. ERRE 641; QUIT G_THETA;
  809. FINSI;
  810. SI (NON (EXIS SUPTAB 'LEVRE_INFERIEURE'));
  811. MESS 'ERREUR : IL FAUT DONNER LA FISSURE';
  812. MESS '(LEVRE_SUPERIEURE ou LEVRE_INFERIEURE ou les 2)' ;
  813. ERRE 641; QUIT G_THETA;
  814. SINON;
  815. SUPTAB.'FISSURE' = SUPTAB.'LEVRE_INFERIEURE';
  816. FINSI;
  817. SINON;
  818. SI (NON (EXIS SUPTAB 'LEVRE_INFERIEURE'));
  819. SI (EGA IINTE 99);
  820. MESS 'ERREUR : ON VEUT LA LEVRE INFERIEURE DE LA FISSURE';
  821. ERRE 641; QUIT G_THETA;
  822. FINSI;
  823. SUPTAB.'FISSURE' = SUPTAB.'LEVRE_SUPERIEURE';
  824. SINON;
  825. SUPTAB.'FISSURE' = (SUPTAB.'LEVRE_SUPERIEURE') ET
  826. (SUPTAB.'LEVRE_INFERIEURE');
  827. FINSI;
  828. FINSI;
  829. SI IFROT;
  830. MESS 'ERREUR : CONTACT via MODELE_FISSURE avec XFEM seulement';
  831. ERRE 641; QUIT G_THETA;
  832. FINS;
  833. FINSI;
  834.  
  835. ****************************************************
  836. ******* DETERMINATION DES CHAMPS THETA ET PI *******
  837. ******* ET DE LA ZONE DE TRAVAIL ELTETA *******
  838. ****************************************************
  839. si(flmess); mess 'DETERMINATION DES CHAMPS THETA'; fins;
  840.  
  841. *** nombre de COUCHE donne => on calcule tout le reste
  842. * CHAMP_THETA + DIRTETA
  843. SI (EXIS SUPTAB 'COUCHE');
  844. SI(IXFEM);
  845. SUPTAB.'CHAMP_THETA' UTILTETA = CH_THETX SUPTAB;
  846. SUPTAB.'UTILTET1' = UTILTETA;
  847. SINO;
  848. SUPTAB.'CHAMP_THETA' UTILTETA = CH_THETA SUPTAB;
  849. SUPTAB.'UTILTET1' = UTILTETA;
  850. SI (EGA IINTE 4);
  851. SI (NON (EXIS SUPTAB 'FRONT_FISSURE_2'));
  852. SUPTAB.'COUCHE' = (SUPTAB.'COUCHE') - 1;
  853. SUPTAB.'CHAMP_PI' UTILPI = CH_THETA SUPTAB;
  854. SUPTAB.'COUCHE' = (SUPTAB.'COUCHE') + 1;
  855. SINON;
  856. P1 = SUPTAB.'FRONT_FISSURE';
  857. SUPTAB.'FRONT_FISSURE' = SUPTAB.'FRONT_FISSURE_2';
  858. SUPTAB.'FISSURE' = SUPTAB.'FISSURE_2';
  859. SUPTAB.'CHAMP_PI' UTILPI = CH_THETA SUPTAB;
  860. SUPTAB.'FRONT_FISSURE' = P1;
  861. FINSI;
  862. FINSI;
  863. FINSI;
  864. * ELTETA = ...
  865. si(exis SUPTAB 'MAILLAGE_REDUIT');
  866. * ELTETA = MAILLAGE fourni par l utilisateur (attention pas de test de compati
  867. ELTETA = SUPTAB . 'MAILLAGE_REDUIT';
  868. sino;
  869. * ELTETA = MAILLAGE OU TETA N EST PAS NUL + 1 couche
  870. SI (EGA (TYPE ( SUPTAB.'CHAMP_THETA')) 'CHPOINT ');
  871. uu = EXTR SUPTAB.'CHAMP_THETA' 'MAILLAGE';
  872. SINON;
  873. uu= EXTR SUPTAB.'CHAMP_THETA'.'GLOBAL' 'MAILLAGE';
  874. FINSI;
  875. ELTETA = ELEM MAILLAGE 'APPU' 'LARG' UU;
  876. fins;
  877.  
  878. *** CHAMP_THETA donne, on calcule DIRTETA sur le front de fissure
  879. *(pour faire simple, on appelle CH_THETA pour cela, mais ce n'est pas economique
  880. SINON;
  881. SI(EXIS SUPTAB 'CHAMP_THETA');
  882. MESS 'CHAMP_THETA FOURNI PAR L UTILISATEUR';
  883. q7 = SUPTAB.'CHAMP_THETA';
  884. SI (NEG (TYPE q7) 'CHPOINT ');
  885. q7= q7 . 'GLOBAL' ;
  886. FINSI;
  887. * ELTETA = ...
  888. si(exis SUPTAB 'MAILLAGE_REDUIT');
  889. * ELTETA = MAILLAGE fourni par l utilisateur (attention pas de test de compa
  890. ELTETA = SUPTAB . 'MAILLAGE_REDUIT';
  891. sino;
  892. * ELTETA = MAILLAGE OU TETA N EST PAS NUL + 1 couche
  893. uu = EXTR q7 'MAILLAGE';
  894. ELTETA = ELEM MAILLAGE 'APPU' 'LARG' UU;
  895. fins;
  896. * UTILTETA = ...
  897. SI(EXIS SUPTAB 'UTILTETA');
  898. MESS 'UTILTETA FOURNI PAR L UTILISATEUR';
  899. UTILTETA = SUPTAB . 'UTILTETA';
  900. VECTEUR1 = UTILTETA . 'DIRECTION1';
  901. VECTEUR2 = UTILTETA . 'DIRECTION2';
  902. SI(EGA &DIME 3); VECTEUR3 = UTILTETA . 'DIRECTION3'; FINSI;
  903. SINON;
  904. UTILTETA = TABL;
  905. * DIRECTIONS dans TABUTIL
  906. VECTEUR1 = INT_COMP ELTETA q7 MESHFR1;
  907. NV1 = PSCA VECTEUR1 VECTEUR1 MU123 MU123;
  908. VECTEUR1 = (VECTEUR1 / (NV1**0.5))
  909. CHAN 'ATTRIBUT' 'NATURE' 'DIFFUS';
  910. UTILTETA . 'DIRECTION1' = VECTEUR1;
  911. SI(EGA &DIME 2);
  912. VECTEUR2 = (-1.*(EXCO VECTEUR1 'UY' 'UX'))
  913. et (EXCO VECTEUR1 'UX' 'UY');
  914. UTILTETA . 'DIRECTION2' = VECTEUR2;
  915. SINO;
  916. * CHT CHN CHB = FRENET SUPTAB.'FRONT_FISSURE';
  917. * VECTEUR1 = -1.*CHN;
  918. * VECTEUR2 = -1.*CHB;
  919. * VECTEUR3 = -1.*CHT;
  920. MESS ' bp: !!! option non testee, mais on est joueur !!!';
  921. modfro = MODE MESHFR1 MECANIQUE ELASTIQUE 'POUT';
  922. VECTEUR3 = (VSUR modfro 'NORM') EXCO MV123 MU123 ;
  923. VECTEUR3 = CHAN 'CHPO' VECTEUR3 'MOYE';
  924. NV3 = PSCA VECTEUR3 VECTEUR3 MU123 MU123;
  925. VECTEUR3 = (VECTEUR3 / (NV3**0.5))
  926. CHAN 'ATTRIBUT' 'NATURE' 'DIFFUS';
  927. VECTEUR2 = (PVEC VECTEUR3 MU123 VECTEUR1 MU123 MU123)
  928. CHAN 'ATTRIBUT' 'NATURE' 'DIFFUS';
  929. UTILTETA . 'DIRECTION2' = VECTEUR2;
  930. UTILTETA . 'DIRECTION3' = VECTEUR3;
  931. FINS;
  932. FINSI;
  933.  
  934. SINO;
  935. *** ni COUCHE ni CHAMP_THETA donne, ERREUR !
  936. MESS 'ERREUR : ON VEUT LE NOMBRE DE COUCHEs D ELEMENTS';
  937. MESS ' AUTOUR DE LA FISSURE QUI SE DEPLACE';
  938. MESS ' ou LE CHAMP_THETA';
  939. MESS ' POUR SIMULER LA PROPAGATION DE LA FISSURE';
  940. ERRE 641; QUIT G_THETA;
  941. FINSI;
  942. FINSI;
  943. *
  944. si(fltrac);
  945. q7 = SUPTAB.'CHAMP_THETA';
  946. si(neg (type q7) 'CHPOINT'); q7 = q7 . 'GLOBAL'; fins;
  947. vq7 = VECT q7 'DEPL' 'BLEU' ;
  948. trac vq7 (MAILLAGE et MESHFR1) 'TITR' 'CHAMP_THETA';
  949. finsi;
  950.  
  951.  
  952. **************************************************
  953. ************** DIRECTIONS UTILES *****************
  954. **************************************************
  955.  
  956. *** DIRECTION DE PROPAGATION DE LA FISSURE = DIRTETA
  957. * SI ((EGA &DIME 2) OU ICOQU);
  958. * DIRTETA = UTILTETA . 'DIRECTION';
  959. DIRTETA = UTILTETA . 'DIRECTION1';
  960. * FINSI;
  961. * SI ((EGA &DIME 3) ET (NON ICOQU));
  962. * IND1 = INDE (UTILTETA.'DIRECTION');
  963. * DIRTETA = 0. 0. 0.;
  964. * REPETER BC1 ((DIME IND1) - 1);
  965. * DIRTETA = DIRTETA 'PLUS' (UTILTETA.'DIRECTION'.(IND1.&BC1));
  966. * FIN BC1;
  967. * FINSI;
  968. * DIRTETA = DIRTETA / (NORM DIRTETA);
  969. si(non ICOQU);
  970. DIRNORM = UTILTETA . 'DIRECTION2';
  971. fins;
  972.  
  973. *** DIRECTION DE CISAILLEMENT SI SEPARATION DE MODES =DIRCISA
  974. *SI ((EGA IINTE 99) ET (EGA &DIME 3) ET (NON ICOQU));
  975. SI ((EGA &DIME 3) ET (NON ICOQU));
  976. * SI(IXFEM);
  977. DIRCISA = UTILTETA . 'DIRECTION3';
  978. * SINON;
  979. * F1 = PRES 'MASS' OBJMOD SUPTAB.'LEVRE_SUPERIEURE' 1.;
  980. * N1 = NBNO SUPTAB.'FRONT_FISSURE';
  981. * P1 = POIN SUPTAB.'FRONT_FISSURE' ((N1 + 1)/2);
  982. * V1 = EXTR F1 MF1 P1;
  983. * V2 = EXTR F1 MF2 P1;
  984. * V3 = EXTR F1 MF3 P1;
  985. * DIRCISA = PVEC DIRTETA (V1 V2 V3);
  986. * FINSI;
  987. * DIRCISA = DIRCISA / (NORM DIRCISA);
  988. FINSI;
  989.  
  990. * si(fltrac);
  991. * *si(vrai);
  992. * dx1 = coor (&DIME + 1) MESHFR1;
  993. * * dx1 = maxi (prog 1. ((maxi (resu dx1)) / (nbno MESHFR1)));
  994. * dx1 = (maxi (resu dx1)) / (nbno MESHFR1);
  995. * vdir7 = (VECT dx1 DIRTETA 'DEPL' 'BLEU')
  996. * et (VECT dx1 DIRNORM 'DEPL' 'ROUG');
  997. * si((EGA &DIME 3) ET (NON ICOQU));
  998. * vdir7 = vdir7 et (VECT dx1 DIRCISA 'DEPL' 'VERT');
  999. * trac vdir7 (MESHFR1 et (aret MAILLAGE)) TITR 'DIRECTIONS LOCALES';
  1000. * sino;
  1001. * trac vdir7 (MESHFR1 et (cont MAILLAGE)) TITR 'DIRECTIONS LOCALES';
  1002. * fins;
  1003. * fins;
  1004.  
  1005.  
  1006. **************************************************
  1007. ************** ON COMPLETE ELTETA **************
  1008. **************************************************
  1009.  
  1010. *** ajout eventuel de ELPIa ELTETA ******
  1011. SI ((EXIS SUPTAB 'FRONT_FISSURE_2') ET (EGA IINTE 4));
  1012. ELPI = SUPTAB.'FRONT_FISSURE_2';
  1013. REPETER MAIL2 ((SUPTAB.'COUCHE') + 1);
  1014. ELPI = MAILLAGE ELEM 'APPU' 'LARG' ELPI ;
  1015. FIN MAIL2 ;
  1016. ELTETA = ELTETA ET ELPI;
  1017. FINSI;
  1018.  
  1019. *** AJOUT DU NOEUD SUPPORT EN DEF.PL.GENERALISEES
  1020. SI (EGA &MODE 'PLANGENE');
  1021. ELTETA = ELTETA ET (VALE 'MODE' 'PLANGENE');
  1022. FINSI;
  1023. ELPOI1 = CHAN ELTETA 'POI1';
  1024.  
  1025. *** L ELEMENT SUPPORTANT LE MODELE MULTICOUCHE
  1026. *** DOIT ETRE DANS LA ZONE THETA
  1027. SI ICOQU;
  1028. N1 = NBNO ELTETA;
  1029. N2 = NBNO (ELTETA ET (EXTR M_MOYE 'MAIL'));
  1030. SI (NEG N1 N2);
  1031. MESS 'ERREUR : L ELEMENT EN MULTICOUCHE DESIGNE POUR CALCULER';
  1032. MESS ' L INTEGRALE SE TROUVE EN DEHORS DE LA ZONE';
  1033. MESS ' DEFINIE PAR LE NOMBRE DE COUCHES DONNE.';
  1034. ERRE 21; QUIT G_THETA;
  1035. FINSI;
  1036. FINSI;
  1037.  
  1038.  
  1039. **************************************************
  1040. *********** TESTER SI REPRISE DE CALCUL **********
  1041. **************************************************
  1042.  
  1043. *** REPRISE DE CALCUL ? **************************
  1044. IREPRI = FAUX;
  1045. SI (IPAP ET (NON IPERSO1));
  1046. N1 = DIME (SUPTAB.'SOLUTION_PASAPAS'.'TEMPS');
  1047. SI ((EXIS SUPTAB 'IABC') ET
  1048. *bp (EXIS SUPTAB 'COU1') ET
  1049. *bp (EXIS SUPTAB 'CHAMP_THETA') ET
  1050. (EXIS SUPTAB 'ELTET1') ET
  1051. (EXIS SUPTAB 'RESULTATS') ET
  1052. (EXIS SUPTAB 'EVOLUTION_RESULTATS'));
  1053. IREPRI = '>' (N1 - 1) SUPTAB.'IABC';
  1054. mess 'on tente une reprise...';
  1055. FINSI;
  1056. FINSI;
  1057.  
  1058. *** TESTS DE COMPATIBILITE SI REPRISE DE CALCUL ***
  1059. SI IREPRI;
  1060. * on verifie que l objectif reste le meme
  1061. SI (NEG SUPTAB.'OBJ1' SUPTAB.'OBJECTIF');
  1062. MESS 'ERREUR : REPRISE IMPOSSIBLE CAR L OBJECTIF DU';
  1063. MESS ' CALCUL ACTUEL N EST PAS LE MEME QUE';
  1064. MESS ' CELUI DU CALCUL PRECEDENT';
  1065. ERRE 21; QUIT G_THETA;
  1066. FINSI;
  1067. * on doit avoir le meme nombre de couche (on suppose la fissure fixe)
  1068. SI ((EXIS SUPTAB 'COUCHE') et (EXIS SUPTAB 'COU1'));
  1069. SI (NEG SUPTAB.'COU1' SUPTAB.'COUCHE');
  1070. MESS 'ERREUR : REPRISE IMPOSSIBLE CAR LE NOMBRE DE';
  1071. MESS ' COUCHE ACTUEL N EST PAS LE MEME QUE';
  1072. MESS ' CELUI UTILISE POUR LE CALCUL PRECEDENT';
  1073. ERRE 21; QUIT G_THETA;
  1074. FINSI;
  1075. FINSI;
  1076. * reste a verifier la compatibilite des support de champ teta via elteta
  1077. * ELTETA doit etre inclus dans ELTET1
  1078. ELTET1 = SUPTAB.'ELTET1';
  1079. si(neg (nbno ELTETA) (nbno (ELTET1 inte ELTETA)));
  1080. MESS 'ERREUR : REPRISE IMPOSSIBLE CAR LE SUPPORT DU ';
  1081. MESS ' CHAMP_THETA FOURNI N EST PAS INCLUS DANS';
  1082. MESS ' CELUI UTILISE POUR LE CALCUL PRECEDENT';
  1083. ERRE 21; QUIT G_THETA;
  1084. fins;
  1085. MESS 'REPRISE DU CALCUL AUTORISE !';
  1086. FINSI;
  1087.  
  1088. *** TESTS DE COMPATIBILITE SI UTILISATION DE PERSO1 ***
  1089. SI (IPERSO1 et (EXIS SUPTAB 'ELTET1'));
  1090. ELTET1 = SUPTAB.'ELTET1';
  1091. si(neg (nbno ELTETA) (nbno (ELTET1 inte ELTETA)));
  1092. MESS 'ERREUR : REPRISE IMPOSSIBLE CAR LE SUPPORT DU ';
  1093. MESS ' CHAMP_THETA FOURNI N EST PAS INCLUS DANS';
  1094. MESS ' CELUI UTILISE POUR LE CALCUL PRECEDENT';
  1095. ERRE 21; QUIT G_THETA;
  1096. fins;
  1097. si(flmess); MESS 'POURSUITE DU CALCUL via PERSO1 AUTORISE !'; fins;
  1098. FINS;
  1099.  
  1100.  
  1101.  
  1102. **************************************************
  1103. ** MODELES ET MATERIAUX DANS LA ZONE DE TRAVAIL **
  1104. **************************************************
  1105.  
  1106. *** VERIFICATION DES DONNEES D ENTREE POUR MODELES_COMPOSITES
  1107. SI (EXIS SUPTAB 'MODELES_COMPOSITES');
  1108. SI ((&DIME EGA 3) ET (NON ICOQU));
  1109. MESS 'ERREUR : ON NE PEUT ENCORE TRAITER LES PROBLEMES';
  1110. MESS ' DE MATERIAUX COMPOSITES EN 3D MASSIF';
  1111. ERRE 21; QUIT G_THETA;
  1112. FINSI;
  1113. N1 = DIME SUPTAB.'MODELES_COMPOSITES';
  1114. SI ('<' N1 2);
  1115. MESS 'ERREUR : IL FAUT AU MOINS DEUX MODELES POUR';
  1116. MESS ' DETERMINER LA LIGNE COMMUNE D INTERFACE';
  1117. ERRE 21; QUIT G_THETA;
  1118. FINSI;
  1119. M1 = EXTR OBJMOD 'MAIL';
  1120. REPETER BIN4 N1;
  1121. T1 = TYPE SUPTAB.'MODELES_COMPOSITES'.&BIN4;
  1122. SI (NEG T1 'MMODEL ');
  1123. MESS 'ERREUR : LE TYPE DE L OBJET No' &BIN4 'DANS LA';
  1124. MESS ' TABLE MODELES_COMPOSITES EST INCORRECTE';
  1125. ERRE 21; QUIT G_THETA;
  1126. FINSI;
  1127. SI (EGA &BIN4 1);
  1128. M2 = EXTR SUPTAB.'MODELES_COMPOSITES'.&BIN4 'MAIL';
  1129. SINON;
  1130. M2 = M2 ET
  1131. (EXTR SUPTAB.'MODELES_COMPOSITES'.&BIN4 'MAIL');
  1132. FINSI;
  1133. FIN BIN4;
  1134. SI (NEG (NBNO M1) (NBNO M2));
  1135. MESS 'ERREUR : TOUS LES MODELES DE MATERIAUX';
  1136. MESS ' COMPOSITES NE SONT PAS DONNES';
  1137. ERRE 21; QUIT G_THETA;
  1138. FINSI;
  1139. FINSI;
  1140.  
  1141. *** CREATION DE OBJMOD ET TABMOD *****************
  1142. TABMOD = TABL;
  1143. SI (EXIS SUPTAB 'MODELES_COMPOSITES');
  1144. * CAS DE MODELES COMPOSITES (AVEC DISCONTINUITE) : ON A DU TRAVAIL
  1145. REPETER BIN1 (DIME SUPTAB.'MODELES_COMPOSITES');
  1146. M1 = SUPTAB.'MODELES_COMPOSITES'.&BIN1;
  1147. M2 = EXTR M1 'MAIL';
  1148. N1 = NBNO M2;
  1149. N2 = NBNO ELTETA;
  1150. N3 = NBNO (ELTETA ET M2);
  1151. * si on a des noeuds en commun, ...
  1152. SI (NEG (N1 + N2) N3);
  1153. M2 = CHAN M2 'POI1';
  1154. * ... on les recupere
  1155. E1 = (DIFF ELPOI1 M2) DIFF (ELPOI1 ET M2);
  1156. N1 = NBNO (CONT ELTETA);
  1157. N2 = NBNO (E1 ET (CONT ELTETA));
  1158. * si tous les noeuds en commun sont sur le contour
  1159. * => pas d elements a recuperer => on passe au modele suivant
  1160. SI (EGA N1 N2);
  1161. ITER BIN1;
  1162. FINSI;
  1163. * sinon, on recupere les elements concernes et le modele reduit
  1164. E1 = MAILLAGE ELEM 'APPU' 'STRI' E1;
  1165. N1 = (DIME TABMOD) + 1;
  1166. TABMOD.N1 = REDU M1 E1;
  1167. SI (EGA N1 1);
  1168. OBJMOD = TABMOD.N1;
  1169. SINON;
  1170. OBJMOD = OBJMOD ET TABMOD.N1;
  1171. FINSI;
  1172. FINSI;
  1173. FIN BIN1;
  1174. SINON;
  1175. * CAS DE MODELES SANS DISCONTINUITE : ON A MOINS DE TRAVAIL
  1176. OBJMOD = REDU OBJMOD ELTETA;
  1177. TABMOD.1 = OBJMOD;
  1178. FINSI;
  1179. * list OBJMOD;
  1180. NBOBJ = DIME TABMOD;
  1181. OBJMAT = REDU OBJMAT OBJMOD;
  1182.  
  1183. *** CHAMP EPAISSEUR DANS LA ZONE DE TRAVAIL ******
  1184. SI ICOQU;
  1185. EPAICH = (CHAN (EXCO OBJMAT 'EPAI' 'SCAL')
  1186. 'STRESSES' OBJMOD) CHAN 'TYPE' 'SCALAIRE';
  1187. FINSI;
  1188.  
  1189.  
  1190. **************************************************
  1191. ** CALCUL DE C* PAR DEUX TYPES DE MODELE FLUAGE **
  1192. **************************************************
  1193. *** ITYPEF = 1 MODELE FLUAGE POUR LEQUEL ON A UNE EXPRESSION
  1194. *** EXPLICITE DE L'INTEGRATION DE LA VITESSE DE
  1195. *** DEFORMATION DE FLUAGE SUR LE TEMPS
  1196. *** ITYPEF = 2 MODELE FLUAGE POUR LEQUEL ON N'OBTIENT PAS
  1197. *** FACILEMENT CETTE EXPRESSION EXPLICITE
  1198. *** ITYPEF = 99 SI EN ELASTO OU THERMO-ELASTO-PLASTICITE
  1199.  
  1200. *** VERIF DES DONNEES ****************************
  1201. SI ((EGA IINTE 2) OU (EGA IINTE 3));
  1202. SI (NON (EXIS OBJMOD 'MATE' 'FLUAGE'));
  1203. MESS 'ERREUR : LA FORMULATION DU PROBLEME NE PERMET';
  1204. MESS ' PAR DE CALCULER L INTEGRALE SPECIFIEE';
  1205. ERRE 21; QUIT G_THETA;
  1206. FINSI;
  1207. FINSI;
  1208. SI (EGA IINTE 3);
  1209. SI ((EXIS OBJMOD 'MATE' 'FLUAGE' 'BLACKBURN') OU
  1210. (EXIS OBJMOD 'MATE' 'FLUAGE' 'RCCMR_316') OU
  1211. (EXIS OBJMOD 'MATE' 'FLUAGE' 'RCCMR_304') OU
  1212. (EXIS OBJMOD 'MATE' 'FLUAGE' 'POLYNOMIAL') OU
  1213. (EXIS OBJMOD 'MATE' 'FLUAGE' 'LEMAITRE'));
  1214. MESS 'ERREUR : IL FAUT UN MODELE DE FLUAGE NORTON';
  1215. MESS ' SEUL POUR CALCULER L INTEGRALE C*(H)';
  1216. ERRE 21; QUIT G_THETA;
  1217. FINSI;
  1218. FINSI;
  1219.  
  1220. *** DETERMINATION DE ITYPEF *********************
  1221. ITYPEF = 99;
  1222. SI ((EGA IINTE 2) OU (EGA IINTE 3));
  1223. SI ((EXIS OBJMOD 'MATE' 'FLUAGE' 'NORTON') OU
  1224. (EXIS OBJMOD 'MATE' 'FLUAGE' 'POLYNOMIAL'));
  1225. ITYPEF = 1;
  1226. FINSI;
  1227. SI ((EXIS OBJMOD 'MATE' 'FLUAGE' 'BLACKBURN') OU
  1228. (EXIS OBJMOD 'MATE' 'FLUAGE' 'RCCMR_316') OU
  1229. (EXIS OBJMOD 'MATE' 'FLUAGE' 'RCCMR_304') OU
  1230. (EXIS OBJMOD 'MATE' 'FLUAGE' 'LEMAITRE'));
  1231. ITYPEF = 2;
  1232. FINSI;
  1233. FINSI;
  1234.  
  1235.  
  1236. **************************************************
  1237. ******* INTERFACES DANS LA ZONE DE TRAVAIL *******
  1238. **************************************************
  1239.  
  1240. *** CREATION DES INTERFACES INTER-MODELE *********
  1241. IPARAL = VRAI; LINTER = TABL;
  1242. SI ((EXIS SUPTAB 'MODELES_COMPOSITES')
  1243. ET ('>' (DIME TABMOD) 1));
  1244. * on boucle sur les modeles qui appartiennent a ELTETA
  1245. REPETER BIN2 ((DIME TABMOD) - 1);
  1246. M1 = EXTR (TABMOD.&BIN2) 'MAIL';
  1247. IIN3 = &BIN2;
  1248. NIN3 = (DIME TABMOD) - &BIN2;
  1249. REPETER BIN3 NIN3;
  1250. IIN3 = IIN3 + 1;
  1251. LE1 = LECT &BIN2 IIN3;
  1252. M2 = EXTR (TABMOD . IIN3) 'MAIL';
  1253. * On itere si (M1 inclut dans M2) ou (M2 inclut dans M1)
  1254. SI (EGA (NBNO (M1 DIFF M2)) 0);
  1255. ITER BIN3;
  1256. FINSI;
  1257. * On itere si M1 et M2 n ont pas de noeuds communs
  1258. SI (EGA ((NBNO M1) + (NBNO M2)) (NBNO (M1 ET M2)));
  1259. ITER BIN3;
  1260. FINSI;
  1261. * On recupere l interface M1-M2
  1262. L1 = (CONT M1) ELEM 'APPU' (CONT M2);
  1263. N1 = NBNO M1; N2 = NBNO M2;
  1264. * LO1=vrai <=> il existe des noeuds communs a M1 et M2
  1265. LO1 = NEG (N1 + N2) (NBNO (M1 ET M2));
  1266. * LO2=vrai <=> il n'y a pas 1 noeud commun a M1 et M2
  1267. LO2 = NEG ('ABS' ((N1 + N2) - (NBNO (M1 ET M2)))) 1;
  1268. * LO4 = M1 et M2 forment bien une interface et ne se chevauchent pas
  1269. LO4 = NEG (NBEL L1) 0;
  1270. * SI (LO1 ET LO2 ET LO3);
  1271. SI (LO1 ET LO2 ET LO4);
  1272. * on ajoute l interface car on a >1 noeuds en commun a M1 et M2
  1273. LINTER.LE1 = L1;
  1274. * IPARAL=vrai <=> toutes les interfaces sont // a la fissure
  1275. * rem: si IPARAL=faux, alors il faut ajouter des termes d interfaces au c
  1276. P1 = (POIN L1 1) 'MOIN' (POIN L1 2);
  1277. P1 = P1 / (NORM P1);
  1278. *petite modif car DIRTETA doit etre un chpoint desormais (a verifier)...
  1279. PDIRTETA = resu DIRTETA;
  1280. Presu = (extr PDIRTETA 'MAIL') poin 1;
  1281. xDIRTETA = extr PDIRTETA Presu 'UX';
  1282. yDIRTETA = extr PDIRTETA Presu 'UY';
  1283. si(&DIME ega 2);
  1284. PDIRTETA = xDIRTETA yDIRTETA;
  1285. sino;
  1286. zDIRTETA = extr PDIRTETA Presu 'UZ';
  1287. PDIRTETA = xDIRTETA yDIRTETA zDIRTETA;
  1288. fins;
  1289. PDIRTETA = PDIRTETA / (norm PDIRTETA);
  1290. LO1 = ((EGA P1 PDIRTETA 1.E-6) OU
  1291. (EGA P1 (-1.*PDIRTETA) 1.E-6));
  1292. IPARAL = IPARAL ET LO1;
  1293. FINSI;
  1294. FIN BIN3;
  1295. FIN BIN2;
  1296. FINSI;
  1297.  
  1298. **** dans le cas decouplage seulement :
  1299. **** TEST SI FRONT_FISSURE EST DANS UNE INTERFACE ****
  1300. IDANS = FAUX;
  1301. SI ((NEG (dime LINTER) 0) ET (EGA IINTE 99));
  1302. IND1 = INDE LINTER;
  1303. REPETER BIN4 (DIME IND1);
  1304. LE1 = IND1.&BIN4;
  1305. M1 = CHAN LINTER.LE1 'POI1';
  1306. N1 = NBNO M1;
  1307. N2 = NBNO (M1 ET SUPTAB.'FRONT_FISSURE');
  1308. SI (EGA N1 N2);
  1309. IDANS = VRAI;
  1310. QUIT BIN4;
  1311. SINON;
  1312. ITER BIN4;
  1313. FINSI;
  1314. FIN BIN4;
  1315. FINSI;
  1316. *** SI OUI (IDANS),ON DETERMINE LES MODELES SUP ET INF *******
  1317. MODINF = 0; MODSUP = 0;
  1318. SI IDANS;
  1319. * on redefinit : IPARAL=vrai <=> l'interface a laquelle appartient la fissure e
  1320. IPARAL=FAUX;
  1321. M1 = EXTR TABMOD.(EXTR LE1 1) 'MAIL';
  1322. M2 = EXTR TABMOD.(EXTR LE1 2) 'MAIL';
  1323. LSUP = SUPTAB.'LEVRE_SUPERIEURE';
  1324. LINF = SUPTAB.'LEVRE_INFERIEURE';
  1325. N1 = NBNO M1;
  1326. N2 = NBNO M2;
  1327. NLSUP = NBNO LSUP;
  1328. NLINF = NBNO LINF;
  1329. N1SUP = NBNO (M1 ET LSUP);
  1330. N2INF = NBNO (M2 ET LINF);
  1331. SI ( ((N1 + NLSUP - N1SUP) > 1) ET ((N2 + NLINF - N2INF) > 1));
  1332. * LSUP et Mod1 ont plus d'1 point commun ET idem pour LINF et Mod2
  1333. MODSUP = TABMOD.(EXTR LE1 1);
  1334. MODINF = TABMOD.(EXTR LE1 2);
  1335. SINON;
  1336. N1INF = NBNO (M1 ET LINF);
  1337. N2SUP = NBNO (M2 ET LSUP);
  1338. SI ( ((N1 + NLINF - N1INF) > 1) ET ((N2 + NLSUP - N2SUP) > 1));
  1339. MODSUP = TABMOD.(EXTR LE1 2);
  1340. MODINF = TABMOD.(EXTR LE1 1);
  1341. SINON;
  1342. MESS 'ERREUR : INCOMPATIBILITE ENTRE LE MODELES_COMPOSITES';
  1343. MESS ' ET LES LEVRE_SUPERIEURE ET _INFERIEURE';
  1344. ERRE 21; QUIT G_THETA;
  1345. FINSI;
  1346. FINSI;
  1347. * LA FISSURE EST BIEN DANS LE PROLONGEMENT DE L' INTERFACE
  1348. IPARAL=VRAI;
  1349. FINSI;
  1350. * REM: il faudrait egalement verifier que MODSUP et MODINF suffisent a decrire E
  1351.  
  1352.  
  1353. **************************************************
  1354. *** MODPLA : table indicee par entier pour stocker les modeles
  1355. *** mecaniques de chaque objet MMODEL.
  1356. **************************************************
  1357. *** Elle est vide si le modele est elastique ou elastoplastique
  1358. *** avec une courbe de traction independante de la temperature.
  1359. *** Dans le cas contraire la table vaut :
  1360. *** 1 si le modele est plastique isotrope. Alors une
  1361. *** nouvelle courbe de traction EPSE-SIGMA est faite.
  1362. *** 2 si le modele est plastique cinematique
  1363. *** 3 si le modele est plastique parfaite
  1364.  
  1365. YOUVARI = FAUX; NUVARI = FAUX;
  1366. ALFVARI = FAUX; MODPLA = TABLE; TABTRA = TABLE;
  1367. REPETER BCMOD1 NBOBJ;
  1368. MODI = TABMOD.&BCMOD1;
  1369. MATI = REDU OBJMAT MODI;
  1370. *
  1371. *** YOUVARI **************************************
  1372. YO1 = EXCO MATI 'YOUN';
  1373. TYPYO = TYPE (EXTR YO1 'YOUN' 1 1 1);
  1374. SI (EGA TYPYO 'EVOLUTIO');
  1375. YOUVARI = VRAI;
  1376. SINON;
  1377. TEST1 = ((MAXI YO1) - (MINI YO1))/(MINI YO1);
  1378. SI (TEST1 '>' 1.E-10);
  1379. YOUVARI = VRAI;
  1380. FINSI;
  1381. FINSI;
  1382. *
  1383. *** NUVARI **************************************
  1384. NU1 = EXCO MATI 'NU';
  1385. TYPNU = TYPE (EXTR NU1 'NU' 1 1 1);
  1386. SI (EGA TYPNU 'EVOLUTIO');
  1387. NUVARI = VRAI;
  1388. SINON;
  1389. TEST1 = ((MAXI NU1) - (MINI NU1))/(MINI NU1);
  1390. SI (TEST1 '>' 1.E-10);
  1391. NUVARI = VRAI;
  1392. FINSI;
  1393. FINSI;
  1394. *
  1395. *** ALFVARI **************************************
  1396. SI ITHER;
  1397. AL1 = EXCO MATI 'ALPH';
  1398. TYPAL = TYPE (EXTR AL1 'ALPH' 1 1 1);
  1399. SI (EGA TYPAL 'EVOLUTIO');
  1400. ALFVARI = VRAI;
  1401. SINON;
  1402. TEST1 = ((MAXI AL1) - (MINI AL1))/(MINI AL1);
  1403. SI (TEST1 '>' 1.E-10);
  1404. ALFVARI = VRAI;
  1405. FINSI;
  1406. FINSI;
  1407. FINSI;
  1408. *
  1409. *** courbe de TRACtion ***************************
  1410. SI (EXIS MATI 'TRAC');
  1411. TR1 = EXCO MATI 'TRAC';
  1412. TYPTR = TYPE (EXTR TR1 'TRAC' 1 1 1);
  1413. SI (EGA TYPTR 'NUAGE ');
  1414. MODPLA.&BCMOD1 = 1;
  1415. TRA1 = EXTR TR1 'TRAC' 1 1 1; COM1 = EXTR TRA1 'COMP';
  1416. NOMEVO1 = MOT 'TRAC'; NOMFLO1 = MOT 'T';
  1417. REPETER BNUA1 (DIME TRA1 'UPLE');
  1418. SI (EGA &BNUA1 1);
  1419. NUA1 = EXTR TRA1 'MINI' NOMFLO1;
  1420. SINON;
  1421. NUA1 = EXTR TRA1 'SUPE' NOMFLO1 (T1 + 1.E-10);
  1422. FINSI;
  1423. T1 = EXTR NUA1 NOMFLO1;
  1424. EV1 = EXTR NUA1 NOMEVO1;
  1425. PSIG1 = EXTR EV1 ORDO; PEPS1 = EXTR EV1 'ABSC';
  1426. VYOU1 = (EXTR 2 PSIG1) / (EXTR 2 PEPS1);
  1427. PEPS2 = PROG;
  1428. REPETER BSIG1 ((DIME PSIG1) - 1);
  1429. VA1 = (EXTR (&BSIG1 + 1) PEPS1) -
  1430. ((EXTR (&BSIG1 + 1) PSIG1) / VYOU1);
  1431. PEPS2 = PEPS2 ET (PROG VA1);
  1432. FIN BSIG1;
  1433. EV1 = EVOL 'MANU' 'EPSE' PEPS2 SIGM ('ENLE' PSIG1 1);
  1434. SI (&BNUA1 EGA 1);
  1435. TRA2 = 'NUAG' 'COMP' NOMFLO1 T1 'COMP' NOMEVO1 EV1;
  1436. SINON;
  1437. TRA2 = TRA2 ET ('NUAG' 'COMP' NOMFLO1
  1438. T1 'COMP' NOMEVO1 EV1);
  1439. FINSI;
  1440. FIN BNUA1;
  1441. TABTRA.&BCMOD1 = TRA2;
  1442. *** On enleve la courbe de traction si elle depend de
  1443. *** la temperature (operation trop couteuse pour VARI)
  1444. MAT0 = MATI; LCOMP1 = EXTR MAT0 'COMP';
  1445. REPETER BCOM1 (DIME LCOMP1);
  1446. C1 = EXTR LCOMP1 &BCOM1;
  1447. SI (NEG C1 'TRAC');
  1448. SI (EGA &BCOM1 1);
  1449. MATI = 'MATE' MODI C1 (EXCO C1 MAT0);
  1450. SINON;
  1451. MATI = MATI ET ('MATE' MODI C1 (EXCO C1 MAT0));
  1452. FINSI;
  1453. FINSI;
  1454. FIN BCOM1;
  1455. FINSI;
  1456.  
  1457. *** SIGY (et pas TRAC) *************************
  1458. SINON;
  1459. SI (EXIS MATI 'SIGY');
  1460. SI1 = EXCO MATI 'SIGY';
  1461. TYPSI = TYPE (EXTR SI1 'SIGY' 1 1 1);
  1462. SI (EXIS MATI 'H');
  1463. H1 = EXCO MATI 'H';
  1464. TYPH = TYPE (EXTR H1 'H' 1 1 1);
  1465. SI ((EGA TYPH 'EVOLUTIO') OU
  1466. (EGA TYPSI 'EVOLUTIO'));
  1467. MODPLA.&BCMOD1 = 2;
  1468. FINSI;
  1469. SINON;
  1470. SI (EGA TYPSI 'EVOLUTIO');
  1471. MODPLA.&BCMOD1 = 3;
  1472. FINSI;
  1473. FINSI;
  1474. FINSI;
  1475. FINSI;
  1476. FIN BCMOD1;
  1477. MATVARI = YOUVARI OU NUVARI OU ALFVARI OU ((DIME MODPLA) '>' 0);
  1478.  
  1479.  
  1480. **************************************************
  1481. ************ CAS IMPOSSIBLE A TRAITER ************
  1482. **************************************************
  1483.  
  1484. SI (EXIS SUPTAB 'MODELES_COMPOSITES');
  1485. * SI ((EGA IINTE 99) ET (NON IPARAL));
  1486. SI ((EGA IINTE 99) ET (IDANS ET (NON IPARAL)));
  1487. MESS 'ERREUR : ON NE PEUT ENCORE DECOUPLER LES MODES';
  1488. MESS ' DANS LE CAS DES MATERIAUX COMPOSITES';
  1489. MESS ' SI LA FISSURE N APPARTIENT PAS A L INTERFACE';
  1490. ERRE 21; QUIT G_THETA;
  1491. FINSI;
  1492. * SI ((EGA IINTE 4) ET (NON IPARAL));
  1493. SI ((EGA IINTE 4) ET (NEG (dime LINTER) 0));
  1494. MESS 'ERREUR : ON NE PEUT ENCORE CALCULER DJ/DA';
  1495. MESS ' DANS LE CAS DES MATERIAUX COMPOSITES';
  1496. ERRE 21; QUIT G_THETA;
  1497. FINSI;
  1498. SINON;
  1499. SI ((EGA IINTE 99) ET MATVARI);
  1500. MESS 'ERREUR : ON NE PEUT DECOUPLER LES MODES';
  1501. MESS ' DANS LE CAS DES CARACTERISTIQUES';
  1502. MESS ' MATERIELS VARIABLES DANS L ESPACE';
  1503. ERRE 21; QUIT G_THETA;
  1504. FINSI;
  1505. SI ((EGA IINTE 4) ET MATVARI);
  1506. MESS 'ERREUR : ON NE PEUT ENCORE CALCULER DJ/DA DANS';
  1507. MESS ' LE CAS DES CARACTERISTIQUES MATERIELS';
  1508. MESS ' VARIABLES DANS L ESPACE';
  1509. ERRE 21; QUIT G_THETA;
  1510. FINSI;
  1511. FINSI;
  1512. *
  1513. SI ((EGA IINTE 99) ET ICOQU);
  1514. MESS 'ERREUR : ON NE PEUT ENCORE DECOUPER LES MODES';
  1515. MESS ' DANS LE CAS DES ELEMENTS DE COQUE';
  1516. ERRE 21; QUIT G_THETA;
  1517. FINSI;
  1518. SI ((EGA IINTE 4) ET ICOQU);
  1519. MESS 'ERREUR : ON NE PEUT ENCORE CALCULER DJ/DA';
  1520. MESS ' DANS LE CAS DES ELEMENTS DE COQUE';
  1521. ERRE 21; QUIT G_THETA;
  1522. FINSI;
  1523. SI ((EGA IINTE 3) ET ITHER);
  1524. MESS 'ERREUR : ON NE PEUT ENCORE CALCULER L INTEGRALE';
  1525. MESS ' C*(H) DANS LE CAS DE CHARGEMENT THERMIQUE';
  1526. ERRE 21; QUIT G_THETA;
  1527. FINSI;
  1528. SI ((EGA IINTE 2) ET ITHER);
  1529. MESS 'ERREUR : ON NE PEUT ENCORE CALCULER L INTEGRALE';
  1530. MESS ' C* DANS LE CAS DE CHARGEMENT THERMIQUE';
  1531. ERRE 21; QUIT G_THETA;
  1532. FINSI;
  1533. *
  1534. * SI (IGDEP ET (NEG IINTE 1));
  1535. *BP : on propose de calculer malgre tout...
  1536. SI (IGDEP ET ((NEG IINTE 1) et (NEG IINTE 5) et (NEG IINTE 99)));
  1537. MESS 'ERREUR : ON NE PEUT ENCORE CALCULER L INTEGRALE';
  1538. MESS ' SPECIFIEE EN GRANDS-DEPLACEMENTS';
  1539. ERRE 21; QUIT G_THETA;
  1540. FINSI;
  1541.  
  1542.  
  1543. **************************************************
  1544. *** TITRES A AFFICHER SELON LE PROBLEME TRAITER **
  1545. **************************************************
  1546. SI IPAP;
  1547. TXMECANI= MOT ' Mecanique';
  1548. TXTERMI = MOT ' Thermique';
  1549. TXPRESS = MOT ' Volumique';
  1550. SINON;
  1551. TXMECANI= MOT ' Mecanique';
  1552. TXTERMI = MOT ' Thermique';
  1553. TXPRESS = MOT ' Volumique';
  1554. FINSI;
  1555. MC1 = MOT ' EN VISCO-THERMO-PLASTIQUE';
  1556. MC2 = MOT ' EN VISCO-PLASTICITE';
  1557. MC3 = MOT ' EN THERMO-PLASTICITE';
  1558. MC4 = MOT ' EN ELASTO-PLASTICITE';
  1559. si(exis SUPTAB 'COUCHE');
  1560. MC10 = CHAI ' (Theta ' SUPTAB.'COUCHE' ')';
  1561. sino;
  1562. MC10 = CHAI ' (Theta utilisateur)';
  1563. fins;
  1564. SI (EGA IINTE 1);
  1565. CHA1 = CHAI 'INTEGRALE J EN FONCTION DU TEMPS';
  1566. MOTTI = MOT 'J';
  1567. MOTCO = MOT ' J';
  1568. SI ITHER;
  1569. TX1 = CHAI ' INTEGRALE J' MC3;
  1570. SINON;
  1571. TX1 = CHAI ' INTEGRALE J' MC4;
  1572. FINSI;
  1573. FINSI;
  1574. SI (EGA IINTE 2);
  1575. CHA1 = CHAI 'INTEGRALE C* EN FONCTION DU TEMPS';
  1576. MOTTI = MOT 'C*';
  1577. MOTCO = MOT ' C*';
  1578. SI ITHER;
  1579. TX1 = CHAI ' INTEGRALE C*' MC1;
  1580. SINON;
  1581. TX1 = CHAI ' INTEGRALE C*' MC2;
  1582. FINSI;
  1583. FINSI;
  1584. SI (EGA IINTE 3);
  1585. CHA1 = CHAI 'INTEGRALE C*H EN FONCTION DU TEMPS';
  1586. MOTTI = MOT 'C*H';
  1587.  
  1588. MOTCO = MOT ' C*(H)';
  1589. SI ITHER;
  1590. TX1 = CHAI ' INTEGRALE C*H' MC1;
  1591. SINON;
  1592. TX1 = CHAI ' INTEGRALE C*H' MC2;
  1593. FINSI;
  1594. FINSI;
  1595. SI (EGA IINTE 4);
  1596. SI (EXIS SUPTAB 'FISSURE_2');
  1597. CHA1 = CHAI 'INTEGRALE CROISEE DJi/DAj EN FONCTION DU TEMPS';
  1598. MOTTI = MOT 'DJi/DAj';
  1599. MOTCO = MOT ' dJi/dAj';
  1600. SI ITHER;
  1601. TX1 = CHAI ' INTEGRALE CROISEE DJi/DAj' MC3;
  1602. SINON;
  1603. TX1 = CHAI ' INTEGRALE CROISEE DJi/DAj' MC4;
  1604. FINSI;
  1605. SINON;
  1606. CHA1 = CHAI 'INTEGRALE DJ/DA EN FONCTION DU TEMPS';
  1607. MOTTI = MOT 'DJ/DA';
  1608. MOTCO = MOT ' dJ/dA';
  1609. SI ITHER;
  1610. TX1 = CHAI ' INTEGRALE DJ/DA' MC3;
  1611. SINON;
  1612. TX1 = CHAI ' INTEGRALE DJ/DA' MC4;
  1613. FINSI;
  1614. FINSI;
  1615. FINSI;
  1616. SI (EGA IINTE 5);
  1617. CHA1 = CHAI 'INTEGRALE J DYNAMIQUE EN FONCTION DU TEMPS';
  1618. MOTTI = MOT 'J_DYNA';
  1619. MOTCO = MOT ' J_DYNA';
  1620. SI ITHER;
  1621. TX1 = CHAI ' INTEGRALE J EN THERMO-ELASTO-DYNAMIQUE';
  1622. SINON;
  1623. TX1 = CHAI ' INTEGRALE J EN ELASTO-DYNAMIQUE';
  1624. FINSI;
  1625. FINSI;
  1626. SI (EGA IINTE 99);
  1627. CHA1=CHAI 'F.I.C. Ki EN FONCTION DU TEMPS';
  1628. MOTTI = MOT 'Ki';
  1629. MOTCO = MOT ' K';
  1630. SI ITHER;
  1631. TX1 = CHAI ' SEPARATION DES F.I.C.' MC3;
  1632. SINON;
  1633. TX1 = CHAI ' SEPARATION DES F.I.C.' MC4;
  1634. FINSI;
  1635. FINSI;
  1636. *
  1637. TX2 = CHAI ' Contribution due au chargement' MC10;
  1638. TX3 = CHAI ' ________________________________________';
  1639. si(exis SUPTAB 'COUCHE');
  1640. SI ('>' SUPTAB.'COUCHE' 9);
  1641. TX3 = CHAI ' _________________________________________';
  1642. FINSI;
  1643. SI ('>' SUPTAB.'COUCHE' 99);
  1644. TX3 = CHAI ' __________________________________________';
  1645. FINSI;
  1646. sino;
  1647. TX3 = CHAI ' _____________________________________________';
  1648. fins;
  1649.  
  1650. ***************************************************
  1651. **************** AFFICHAGE DU TITRE **************
  1652. ***************************************************
  1653. SI IPAP;
  1654. SI (EGA &DIME 2);
  1655. SI (EGA IINTE 99);
  1656. MESS ' ' TX1;
  1657. MESS ' ' TX2; MESS ' ' TX3;
  1658. MESS 'Mode No.Pas ' TXMECANI TXTERMI TXPRESS MOTCO;
  1659. SINON;
  1660. MESS ' ' TX1;
  1661. MESS ' ' TX2; MESS ' ' TX3;
  1662. MESS ' No.Pas ' TXMECANI TXTERMI TXPRESS MOTCO;
  1663. FINSI;
  1664. FINSI;
  1665. SI ((EGA &DIME 3) ET (NON ICOQU));
  1666. SI (EGA IINTE 99);
  1667. MESS ' ' TX1;
  1668. MESS ' ' TX2; MESS ' ' TX3;
  1669. MESS 'Mode Noeud No.Pas ' TXMECANI TXTERMI TXPRESS MOTCO;
  1670. SINON;
  1671. MESS ' ' TX1;
  1672. MESS ' ' TX2; MESS ' ' TX3;
  1673. MESS ' Noeud No.Pas ' TXMECANI TXTERMI TXPRESS MOTCO;
  1674. FINSI;
  1675. FINSI;
  1676. SI ICOQU;
  1677. MESS ' ' TX1;
  1678. MESS ' ' TX2; MESS ' ' TX3;
  1679. MESS ' Plan No.Pas ' TXMECANI TXTERMI TXPRESS MOTCO;
  1680. FINSI;
  1681. SINON;
  1682. SI (EGA &DIME 2);
  1683. SI (EGA IINTE 99);
  1684. MESS ' ' TX2; MESS ' ' TX3;
  1685. MESS 'Mode ' TXMECANI TXTERMI TXPRESS MOTCO;
  1686. SINON;
  1687. MESS ' ' TX2; MESS ' ' TX3;
  1688. MESS ' ' TXMECANI TXTERMI TXPRESS MOTCO;
  1689. FINSI;
  1690. FINSI;
  1691. SI ((EGA &DIME 3) ET (NON ICOQU));
  1692. SI (EGA IINTE 99);
  1693. MESS ' ' TX2; MESS ' ' TX3;
  1694. MESS ' Mode Noeud ' TXMECANI TXTERMI TXPRESS MOTCO;
  1695. SINON;
  1696. MESS ' ' TX2; MESS ' ' TX3;
  1697. MESS ' Noeud ' TXMECANI TXTERMI TXPRESS MOTCO;
  1698. FINSI;
  1699. FINSI;
  1700. SI ICOQU;
  1701. MESS ' ' TX2; MESS ' ' TX3;
  1702. MESS ' Plan ' TXMECANI TXTERMI TXPRESS MOTCO;
  1703. FINSI;
  1704. FINSI;
  1705.  
  1706.  
  1707. *******************************************************
  1708. * CONDITIONS AUX LIMITES POUR LE DECOUPLAGE DES MODES *
  1709. * utile dans le cas de l utilisation d une METHODE MECANIQUE
  1710. * pour la creation des champs auxiliaires
  1711. *******************************************************
  1712. SI (EGA IINTE 99);
  1713. PM = SUPTAB.'FRONT_FISSURE';
  1714. SI ((EGA &DIME 3) ET (NON IDANS));
  1715. * SI (EGA &DIME 2);
  1716. * X1 Y1 = COOR MAILLAGE; X0 Y0 = COOR PM;
  1717. * DIS1 = (((X1 - X0)**2) + ((Y1 - Y0)**2))**0.5;
  1718. * SINON;
  1719. * X1 Y1 Z1 = COOR MAILLAGE;
  1720. SI (NON ICOQU); PM = POIN PM 'INIT'; FINSI;
  1721. * X0 Y0 Z0 = COOR PM;
  1722. * DIS1 = (((X1 - X0)**2) + ((Y1 - Y0)**2) + ((Z1 - Z0)**2))**0.5;
  1723. * FINSI;
  1724. * PLOIN1 = POIN 1 (POIN 'MAXI' DIS1);
  1725. * SI (EGA &DIME 2);
  1726. * X1 Y1 = COOR (MAILLAGE DIFF (SUPTAB.'LEVRE_INFERIEURE'
  1727. * ET SUPTAB.'LEVRE_SUPERIEURE'));
  1728. * X0 Y0 = COOR PLOIN1;
  1729. * DIS1 = (((X1 - X0)**2) + ((Y1 - Y0)**2))**0.5;
  1730. * SINON;
  1731. * X1 Y1 Z1 = COOR (MAILLAGE DIFF (SUPTAB.'LEVRE_INFERIEURE'
  1732. * ET SUPTAB.'LEVRE_SUPERIEURE'));
  1733. * X0 Y0 Z0 = COOR PLOIN1;
  1734. * DIS1 = (((X1 - X0)**2) + ((Y1 - Y0)**2) + ((Z1 - Z0)**2))**0.5;
  1735. * FINSI;
  1736. * PLOIN2 = POIN 1 (POIN 'MAXI' DIS1);
  1737. * BLOQ0 = (BLOQ 'DEPL' 'ROTA' PLOIN2) ET (BLOQ MU2 PLOIN1);
  1738.  
  1739. *BP : on fait + simple pour les CL utiles au calcul des champs aux.
  1740. * + tard on fera probablement du tout analytique comme pour les xfem
  1741. * car la methode mecanique n est valable que pour fissure plane et
  1742. * front rectiligne a cause de la direction du chargement difficile a
  1743. * definir sinon
  1744. si(NON ICOQU);
  1745. BLOQ1 = BLOQ 'DEPL' MESHFR1;
  1746. sino;
  1747. BLOQ1 = (BLOQ 'DEPL' MESHFR1) et (BLOQ 'ROTA' MESHFR1);
  1748. fins;
  1749.  
  1750. FINSI;
  1751. FINSI;
  1752.  
  1753.  
  1754. ******************************************
  1755. * FISSURE DANS LE REPERE GLOBAL ET LOCAL *
  1756. ******************************************
  1757.  
  1758. * ELEMENT FINI STANDARD ******************
  1759. SI ((EGA IINTE 99) et (non IXFEM));
  1760.  
  1761. *** CAS 2D *******************************
  1762. SI (EGA &DIME 2);
  1763. * Inclinaison de la fissure par rapport a l'axe global
  1764. XG0 YG0 = COOR PM;
  1765. SEG1 = ORDO (SUPTAB.'LEVRE_SUPERIEURE' ELEM 'APPU' 'LARG' PM) ;
  1766. P_SUP = POIN SEG1 'INIT';
  1767. SI (EGA P_SUP PM);
  1768. P_SUP = POIN SEG1 'FINA';
  1769. FINSI;
  1770. SEG1 = ORDO (SUPTAB.'LEVRE_INFERIEURE' ELEM 'APPU' 'LARG' PM) ;
  1771. P_INF = POIN SEG1 'INIT';
  1772. SI (EGA P_INF PM);
  1773. P_INF = POIN SEG1 'FINA';
  1774. FINSI;
  1775. XP1 = COOR 1 P_SUP; XP2 = COOR 1 P_INF;
  1776. YP1 = COOR 2 P_SUP; YP2 = COOR 2 P_INF;
  1777. ALPHA1 = ATG (YG0 - ((YP1 + YP2)/2.)) (XG0 - ((XP1 + XP2)/2.));
  1778. * Coordonnees dans le repere Global et Local
  1779. XG1 YG1 = COOR ELTETA;
  1780. XL1 = ((XG1 - XG0)*(COS ALPHA1)) + ((YG1 - YG0)*(SIN ALPHA1));
  1781. YL1 = ((YG1 - YG0)*(COS ALPHA1)) - ((XG1 - XG0)*(SIN ALPHA1));
  1782. SI ('<' ('MESU' ('DROI' 1 P_SUP P_INF)) 1.E-10);
  1783. L1 = SUPTAB.'LEVRE_SUPERIEURE' ELEM 'APPU' ELTETA;
  1784. C1 = MANU 'CHPO' L1 1 'SCAL' 1.E-10;
  1785. L2 = SUPTAB.'LEVRE_INFERIEURE' ELEM 'APPU' ELTETA;
  1786. C2 = MANU 'CHPO' L2 1 'SCAL' -1.E-10;
  1787. YL1 = YL1 + C1 + C2;
  1788. FINSI;
  1789. * Coordonnees cylindriques RAY1 TETA1 (1.E-30 pour eviter erreur atg 0 0
  1790. TETA1 = ATG YL1 (XL1 + 1.E-30);
  1791. RAY1 = (((XL1*XL1) + (YL1*YL1))**0.5) + 1.E-10;
  1792. M1 = ELTETA ELEM 'APPU' 'LARG' P_SUP;
  1793. M2 = ELTETA ELEM 'APPU' 'LARG' P_INF;
  1794. VA1 = XTY (MANU 'CHPO' M1 1 'SCAL' 1.)
  1795. (REDU YL1 M1) MTS1 MTS1;
  1796. VA2 = XTY (MANU 'CHPO' M2 1 'SCAL' 1.)
  1797. (REDU YL1 M2) MTS1 MTS1;
  1798. * On inverse afin d'avoir YL1 > 0 pour modsup et <0 pour modinf
  1799. SI (('<' VA1 0.) ET ('>' VA2 0.));
  1800. PPPP = P_SUP; P_SUP = P_INF; P_INF = PPPP;
  1801. MMDD = MODSUP; MODSUP = MODINF; MODINF = MMDD;
  1802. FINSI;
  1803. SI ((EGA XP1 XP2 1.E-10) ET (EGA YP1 YP2 1.E-10));
  1804. TETA_S = REDU TETA1 SUPTAB.'LEVRE_SUPERIEURE';
  1805. TETA_F = REDU TETA1 SUPTAB.'LEVRE_INFERIEURE';
  1806. TETA1 = TETA1 - TETA_S - TETA_F;
  1807. * On se debrouille pour avoir exactement +/-180 sur levre sup/inf
  1808. SI (('>' VA1 0.) ET ('<' VA2 0.));
  1809. TETA1 = TETA1 + ((TETA_S*0.) + 180.) + ((TETA_F*0.) - 180.);
  1810. SINON;
  1811. TETA1 = TETA1 + ((TETA_F*0.) + 180.) + ((TETA_S*0.) - 180.);
  1812. FINSI;
  1813. FINSI;
  1814. * valeur en radian
  1815. TETA1rad = TETA1*VALPI/180.;
  1816. * cas d une interface: on construit 3 zones :
  1817. * PM1 = points du modele 1 / interface
  1818. * PM2 = points du modele 2 / interface
  1819. * L1 = elem de l interface
  1820. SI IDANS;
  1821. M1 = EXTR MODSUP 'MAIL';
  1822. M2 = EXTR MODINF 'MAIL';
  1823. L1 = (CONT M1) ELEM 'APPU' (CONT M2);
  1824. M1 = M1 ELEM 'APPU' 'STRI' ELTETA;
  1825. M2 = M2 ELEM 'APPU' 'STRI' ELTETA;
  1826. PM1 = (CHAN M1 'POI1') DIFF (CHAN L1 'POI1');
  1827. PM2 = (CHAN M2 'POI1') DIFF (CHAN L1 'POI1');
  1828. FINSI;
  1829. * si(fltrac);
  1830. * trac RAY1 ELTETA 'TITR' 'RAY1';
  1831. * trac TETA1 ELTETA 'TITR' 'TETA1' (prog -180. PAS 20. 180.);
  1832. * fins;
  1833.  
  1834. *** CAS 3D *******************************
  1835. SINO;
  1836. mess 'on ne fait pas ici le passage local global en 3D ...?';
  1837. mess 'et on ne calule pas RAY1 TETA1 non plus?';
  1838. FINSI;
  1839.  
  1840.  
  1841. FINSI;
  1842.  
  1843. * XFEM************************************
  1844. SI ((EGA IINTE 99) et (IXFEM));
  1845.  
  1846. *** CAS 2D *******************************
  1847. SI (EGA &DIME 2);
  1848. * On recupere les level set
  1849. PSI1 = REDU PSI0 ELTETA;
  1850. PHI1 = REDU PHI0 ELTETA;
  1851. LV7 = (PSI1 NOMC 'UX') ET (PHI1 NOMC 'UY');
  1852. GLV7 = CHAN (GRAD LV7 OBJMOD) 'TYPE' 'SCALAIRE';
  1853. *trac GLV7 objmod 'TITR' 'GLV7';
  1854. * ce repere est il direct? (si oui/non, SDIR1=+/-1)
  1855. GLV7po = CHAN 'CHPO' OBJMOD GLV7 'MOYE';
  1856. XDIR1 = ((EXCO GLV7po 'UX,X' 'SCAL') * (EXCO GLV7po 'UY,Y'))
  1857. - ((EXCO GLV7po 'UX,Y' 'SCAL') * (EXCO GLV7po 'UY,X'));
  1858. XDIR1 = MAXI (RESU XDIR1);
  1859. SDIR1 = SIGN 'FLOTTANT' XDIR1;
  1860. * Angle ALPHA1 de passage local -> global
  1861. NGPSI1 = ( ((EXCO GLV7 'UX,X' 'SCAL')**2)
  1862. + ((EXCO GLV7 'UX,Y' 'SCAL')**2) )**(-0.5) ;
  1863. NGPHI1 = ( ((EXCO GLV7 'UY,X' 'SCAL')**2)
  1864. + ((EXCO GLV7 'UY,Y' 'SCAL')**2) )**(-0.5) ;
  1865. COS1A = 0.5 * ( ( (EXCO GLV7 'UX,X' 'SCAL') * NGPSI1)
  1866. + (SDIR1 * ( (EXCO GLV7 'UY,Y' 'SCAL') * NGPHI1)) );
  1867. SIN1A = 0.5 * ( ( (EXCO GLV7 'UX,Y' 'SCAL') * NGPSI1)
  1868. - (SDIR1 * ( (EXCO GLV7 'UY,X' 'SCAL') * NGPHI1)) );
  1869. ALPHA1 = (MASQ SIN1A 'EGSUPE' 0.) * (ACOS COS1A);
  1870. *trac ALPHA1 objmod 'TITR' 'ALPHA1';
  1871. COSA2 = COS1A ** 2 ;
  1872. SINA2 = SIN1A ** 2 ;
  1873. SINCOSA = SIN1A * COS1A ;
  1874. * repere local de la fissure
  1875. XL1 = (NOMC PSI1 'SCAL') CHAN 'CHAM' OBJMOD 'STRESSES';
  1876. YL1 = (SDIR1 * (NOMC PHI1 'SCAL')) CHAN 'CHAM' OBJMOD 'STRESSES';
  1877. * Coordonnées cylindriques RAY1 TETA1
  1878. TETA1 = CHAN (ATG YL1 (XL1 + 1.D-30)) 'TYPE' 'SCALAIRE';
  1879. RAY1 = ((XL1**2) + (YL1**2))**0.5;
  1880. RAY1 = CHAN RAY1 'TYPE' 'SCALAIRE';
  1881.  
  1882. *** CAS 3D *******************************
  1883. SINO;
  1884. mess 'DECOUPLAGE 3D XFEM en cours de dvpt...';
  1885. * On recupere les level set
  1886. PSI1 = REDU PSI0 ELTETA;
  1887. PHI1 = REDU PHI0 ELTETA;
  1888. LV7 = (PSI1 NOMC 'UX') ET (PHI1 NOMC 'UY')
  1889. et (MANU 'CHPO' ELTETA 1 'UZ ' 0. 'NATURE' 'DIFFUS');
  1890. GLV7 = CHAN (GRAD LV7 OBJMOD) 'TYPE' 'SCALAIRE';
  1891. SDIR1 = 1.;
  1892. * creation de la matrice de rotation
  1893. V1 = UTILTETA . 'V1';
  1894. V2 = UTILTETA . 'V2';
  1895. V3 = UTILTETA . 'V3';
  1896. ROT1= (EXCO V1 (mots 'UX' 'UY' 'UZ') (mots 'UX,X' 'UY,X' 'UZ,X'))
  1897. ET (EXCO V2 (mots 'UX' 'UY' 'UZ') (mots 'UX,Y' 'UY,Y' 'UZ,Y'))
  1898. ET (EXCO V3 (mots 'UX' 'UY' 'UZ') (mots 'UX,Z' 'UY,Z' 'UZ,Z'));
  1899. ROT1 = EXCO ROT1
  1900. (mots UX,X UX,Y UX,Z UY,X UY,Y UY,Z UZ,X UZ,Y UZ,Z);
  1901. ROT1 = CHAN 'CHAM' ROT1 OBJMOD 'STRESSES' 'GRADIENT';
  1902. * SUPTAB . 'ROT1' = ROT1;
  1903. * repere local de la fissure
  1904. XL1 = (NOMC PSI1 'SCAL') CHAN 'CHAM' OBJMOD 'STRESSES';
  1905. YL1 = (NOMC PHI1 'SCAL') CHAN 'CHAM' OBJMOD 'STRESSES';
  1906. * Coordonnées cylindriques RAY1 TETA1
  1907. TETA1 = CHAN (ATG YL1 (XL1 + 1.D-30)) 'TYPE' 'SCALAIRE';
  1908. RAY1 = ((XL1**2) + (YL1**2))**0.5;
  1909. RAY1 = CHAN RAY1 'TYPE' 'SCALAIRE';
  1910. FINSI;
  1911.  
  1912. * si(fltrac);
  1913. * trac ROT1 OBJMOD 'TITR' 'ROT1';
  1914. * trac RAY1 objmod 'TITR' 'RAY1';
  1915. * trac TETA1 objmod 'TITR' 'TETA1' (prog -180. PAS 20. 180.);
  1916. * finsi;
  1917.  
  1918. FINSI;
  1919.  
  1920.  
  1921.  
  1922. ***************************************************
  1923. ****** FORCE, DEPLACEMENT ET GRADIENT NULS ******
  1924. ***************************************************
  1925.  
  1926. ZER1 = MANU 'CHML' OBJMOD 'SCAL' 0. 'TYPE' 'SCALAIRE' 'STRESSES';
  1927. FOR000 = CHAN 'CHPO' OBJMOD ('ZERO' OBJMOD 'FORCES ');
  1928. DEP000 = CHAN 'CHPO' OBJMOD ('ZERO' OBJMOD 'DEPLACEM');
  1929. SI (EGA &MODE 'PLANGENE');
  1930. FOR000 = MANU 'CHPO' (EXTR OBJMOD 'MAIL') 2 'FX' 0.
  1931. 'FY' 0. 'TITR' 'FORCES ' 'NATURE' 'DIFFUS';
  1932. FOR000 = FOR000 ET (MANU 'CHPO' (VALE 'MODE' 'PLANGENE')
  1933. 3 'FZ' 0. 'MX' 0. 'MY' 0.
  1934. 'TITR' 'FORCES ' 'NATURE' 'DIFFUS');
  1935. DEP000 = MANU 'CHPO' (EXTR OBJMOD 'MAIL') 2 'UX' 0.
  1936. 'UY' 0. 'TITR' 'DEPLACEM' 'NATURE' 'DIFFUS';
  1937. DEP000 = DEP000 ET (MANU 'CHPO' (VALE 'MODE' 'PLANGENE')
  1938. 3 'UZ' 0. 'RX' 0. 'RY' 0.
  1939. 'TITR' 'DEPLACEM' 'NATURE' 'DIFFUS');
  1940. FINSI;
  1941. CMD000 = CHAN 'NOEUD' OBJMOD ('ZERO' OBJMOD 'DEPLACEM');
  1942. CMD001 = CHAN 'STRESSES' OBJMOD ('ZERO' OBJMOD 'DEPLACEM');
  1943. GRA000 = 'ZERO' OBJMOD 'GRADIENT';
  1944. VAR000 = 'ZERO' OBJMOD 'VARINTER';
  1945.  
  1946.  
  1947. **************************************************
  1948. * NOMBRE DE BOUCLE POUR LE CALCUL DES INTEGRALES *
  1949. **************************************************
  1950. SI IPAP;
  1951. NBG = -1;
  1952. NBDEP = DIME (SUPTAB.'SOLUTION_PASAPAS'.'TEMPS');
  1953. SI IREPRI ;
  1954. NBG = SUPTAB.'IABC';
  1955. NBDEP = NBDEP - 1 - NBG;
  1956. FINSI;
  1957. SI IPERSO1;
  1958. NBG = (WTAB . 'PAS') - 1;
  1959. NBDEP = 1;
  1960. FINSI;
  1961. SINON;
  1962. NBG = -1;
  1963. NBDEP = 1;
  1964. FINSI;
  1965.  
  1966.  
  1967. ***************************************************
  1968. ** SOLUTION DU PAS PRECEDENT SI REPRISE DE CALCUL * (ou si perso1)
  1969. ***************************************************
  1970. SI (IREPRI ou (IPERSO1 et (NBG >eg 0))) ;
  1971. SIG1 = (SUPTAB.'SOLUTION_PASAPAS'.'CONTRAINTES'.NBG)
  1972. REDU OBJMOD;
  1973. SI (EXIS (SUPTAB.'SOLUTION_PASAPAS') 'VARIABLES_INTERNES');
  1974. VAR1 = (SUPTAB.'SOLUTION_PASAPAS'.'VARIABLES_INTERNES'.NBG)
  1975. REDU OBJMOD;
  1976. SINON;
  1977. VAR1 = VAR000;
  1978. FINSI;
  1979. MAT1 = SUPTAB.'MAT1';
  1980. WELAS = 0.5*('ENER' OBJMOD SIG1 ('ELAS' OBJMOD SIG1 MAT1));
  1981. * WPLAS = SUPTAB.'END1' - WELAS;
  1982. WPLAS = (redu OBJMOD SUPTAB.'END1') - WELAS;
  1983. SI (EGA ITYPEF 2);
  1984. VDI1 = SUPTAB.'VDI1';
  1985. FINSI;
  1986. SI (((DIME MODPLA) '>' 0) ET ITHER);
  1987. WVMIS = SUPTAB.'ENV1';
  1988. FINSI;
  1989. si(flmess); mess 'RECUP DU PAS PRECEDENT OK'; fins;
  1990. FINSI;
  1991.  
  1992.  
  1993. ***************************************************
  1994. ******** TABLE INFORMATION COMPLEMENTAIRE *********
  1995. ***************************************************
  1996. INFTAB = TABL;
  1997. INFTAB.'MOTTI' = MOTTI;
  1998. INFTAB.'MODCOU' = MODCOU;
  1999. INFTAB.'TABMOD' = TABMOD;
  2000. INFTAB.'LINTER' = LINTER;
  2001. INFTAB.'ICOQU' = ICOQU;
  2002. INFTAB.'IGDEP' = IGDEP;
  2003. INFTAB.'IGDER' = IGDER;
  2004. INFTAB.'IREPRI' = IREPRI;
  2005. INFTAB.'IPAP' = IPAP;
  2006. INFTAB.'ILIN' = ILIN;
  2007. INFTAB.'ITHER' = ITHER;
  2008. INFTAB.'ITHER1' = ITHER1;
  2009. INFTAB.'IPARAL' = IPARAL;
  2010. INFTAB.'MATVARI' = MATVARI;
  2011. INFTAB.'YOUVARI' = YOUVARI;
  2012. INFTAB.'ALFVARI' = ALFVARI;
  2013. INFTAB.'IINTE' = IINTE;
  2014. INFTAB.'IQUA' = IQUA;
  2015. INFTAB.'ELTETA' = ELTETA;
  2016. INFTAB.'OBJMOD' = OBJMOD;
  2017. INFTAB.'MODPLA' = MODPLA;
  2018. INFTAB.'FOR000' = FOR000;
  2019. INFTAB.'DEP000' = DEP000;
  2020. INFTAB.'CMD000' = CMD000;
  2021. INFTAB.'CMD001' = CMD001;
  2022. INFTAB.'GRA000' = GRA000;
  2023. INFTAB.'IXFEM' = IXFEM;
  2024. INFTAB.'ITYPEF' = ITYPEF;
  2025. INFTAB.'IPERSO1' = IPERSO1;
  2026. * ajout sm
  2027. INFTAB.'IDEFI' = IDEFI;
  2028. *ajout BP BT pour le contact frottant
  2029. INFTAB . 'IFROT' = IFROT ;
  2030. si (IFROT);
  2031. INFTAB . 'OBJCON' = OBJCON ;
  2032. fins;
  2033. *fin ajout BP BT
  2034. si(IPERSO1); INFTAB . 'ESTIMATION' = ESTIM; fins;
  2035.  
  2036.  
  2037. ***********************************************
  2038. ***********************************************
  2039. ********* BOUCLE SUR LE PAS DE CALCUL *********
  2040. ***********************************************
  2041. ***********************************************
  2042.  
  2043. REPETER BOUCEXT NBDEP ;
  2044. IABC = NBG + &BOUCEXT;
  2045.  
  2046. ***************************************************
  2047. ** DEPLACEMENTS,CONTRAINTES ... A L INSTANT INST **
  2048. ***************************************************
  2049.  
  2050. *** SOLUTION_PASAPAS ******************************
  2051. SI IPAP;
  2052. *** Cas PERSO1
  2053. SI IPERSO1;
  2054. INST = ESTIM . 'TEMPS' ;
  2055. DEPINT = (ESTIM . 'DEPLACEMENTS') REDU ELTETA;
  2056. SIGF = (ESTIM . 'CONTRAINTES' ) REDU OBJMOD;
  2057. SI (IGDEP ET (NON IGDER));
  2058. SIGF = 'CAPI' SIGF DEPINT OBJMOD;
  2059. FINSI;
  2060. SI IGDER;
  2061. SI (NON (EXIS (SUPTAB.'ROTATION_RIGIDIFIANTE') IABC));
  2062. MESS 'ERREUR : Le deplacement du a une rotation';
  2063. MESS ' rigidifiante au pas ' IABC ' n est pas donne';
  2064. ERRE 21; QUIT G_THETA;
  2065. FINSI;
  2066. DEPINT = DEPINT -
  2067. (REDU SUPTAB.'ROTATION_RIGIDIFIANTE'.IABC ELTETA) ;
  2068. FINSI;
  2069. SI (EXIS ESTIM 'VARIABLES_INTERNES');
  2070. VARF = (ESTIM . 'VARIABLES_INTERNES') REDU OBJMOD;
  2071. SINON;
  2072. VARF = VAR000;
  2073. FINSI;
  2074. SI (EGA IINTE 2);
  2075. SI (EGA IABC 0) ;
  2076. DELTAT = INST + 1.E+30;
  2077. DEPINT = ESTIM . 'DEPLACEMENTS';
  2078. VITDFI = ESTIM . 'DEFORMATIONS_INELASTIQUES';
  2079. SIG1 = SIGF * 1.;
  2080. FINSI;
  2081. SI (IABC '>' 0);
  2082. DELTAT= INST - (ESTIM . 'TEMPS');
  2083. DEPINT= (ESTIM . 'DEPLACEMENTS') - (ESTIM . 'DEPLACEMENTS');
  2084. VITDFI= (ESTIM . 'DEFORMATIONS_INELASTIQUES')
  2085. - (ESTIM . 'DEFORMATIONS_INELASTIQUES');
  2086. FINSI;
  2087. DEPINT = (REDU ELTETA DEPINT) / DELTAT;
  2088. VITDFI = (REDU ELTETA VITDFI) / DELTAT;
  2089. FINSI;
  2090. SI (EGA IINTE 5);
  2091. VITF = (ESTIM .'VITESSES') REDU ELTETA;
  2092. ACCF = (ESTIM .'ACCELERATIONS') REDU ELTETA;
  2093. FINSI;
  2094. *** Cas ou on appelle g_theta apres pasapas
  2095. SINO;
  2096. INST = SUPTAB.'SOLUTION_PASAPAS'.'TEMPS'.IABC ;
  2097. DEPINT = (SUPTAB.'SOLUTION_PASAPAS'.'DEPLACEMENTS'.IABC)
  2098. REDU ELTETA;
  2099. SIGF = (SUPTAB.'SOLUTION_PASAPAS'.'CONTRAINTES'.IABC)
  2100. REDU OBJMOD;
  2101. SI (IGDEP ET (NON IGDER));
  2102. SIGF = 'CAPI' SIGF DEPINT OBJMOD;
  2103. FINSI;
  2104. SI IGDER;
  2105. SI (NON (EXIS (SUPTAB.'ROTATION_RIGIDIFIANTE') IABC));
  2106. MESS 'ERREUR : Le deplacement du a une rotation';
  2107. MESS ' rigidifiante au pas ' IABC ' n est pas donne';
  2108. ERRE 21; QUIT G_THETA;
  2109. FINSI;
  2110. DEPINT = DEPINT -
  2111. (REDU SUPTAB.'ROTATION_RIGIDIFIANTE'.IABC ELTETA) ;
  2112. FINSI;
  2113. SI (EXIS (SUPTAB.'SOLUTION_PASAPAS') 'VARIABLES_INTERNES');
  2114. VARF = (SUPTAB.'SOLUTION_PASAPAS'.'VARIABLES_INTERNES'.IABC)
  2115. REDU OBJMOD;
  2116. SINON;
  2117. VARF = VAR000;
  2118. FINSI;
  2119. SI (EGA IINTE 2);
  2120. SI (EGA IABC 0) ;
  2121. DELTAT = INST + 1.E+30;
  2122. DEPINT = SUPTAB.'SOLUTION_PASAPAS'.'DEPLACEMENTS'.IABC;
  2123. VITDFI = SUPTAB.'SOLUTION_PASAPAS'.
  2124. 'DEFORMATIONS_INELASTIQUES'.IABC;
  2125. SIG1 = SIGF * 1.;
  2126. FINSI;
  2127. SI (IABC '>' 0);
  2128. DELTAT= INST - (SUPTAB.'SOLUTION_PASAPAS'.'TEMPS'.(IABC - 1));
  2129. DEPINT= (SUPTAB.'SOLUTION_PASAPAS'.'DEPLACEMENTS'.IABC) -
  2130. (SUPTAB.'SOLUTION_PASAPAS'.'DEPLACEMENTS'.(IABC - 1));
  2131. VITDFI=
  2132. (SUPTAB.'SOLUTION_PASAPAS'.'DEFORMATIONS_INELASTIQUES' .IABC)
  2133. - (SUPTAB.'SOLUTION_PASAPAS'.'DEFORMATIONS_INELASTIQUES'.(IABC - 1));
  2134. FINSI;
  2135. DEPINT = (REDU ELTETA DEPINT) / DELTAT;
  2136. VITDFI = (REDU ELTETA VITDFI) / DELTAT;
  2137. FINSI;
  2138. SI (EGA IINTE 5);
  2139. VITF = (SUPTAB.'SOLUTION_PASAPAS'.'VITESSES'.IABC)
  2140. REDU ELTETA;
  2141. ACCF = (SUPTAB.'SOLUTION_PASAPAS'.'ACCELERATIONS'.IABC)
  2142. REDU ELTETA;
  2143. FINSI;
  2144. FINSI;
  2145. *** SOLUTION_RESO **********************************
  2146. SINON;
  2147. DEPINT = REDU (SUPTAB.'SOLUTION_RESO') ELTETA;
  2148. SIGF = SIGM 'LINE' DEPINT OBJMOD OBJMAT;
  2149. FINSI;
  2150.  
  2151. *** ON CHANGE LE DEPLACEMENT DEPINT EN MCHAML AU NOEUD ******
  2152. *bp: utilite?
  2153. DEPINT = CHAN 'CHAM' DEPINT OBJMOD 'NOEUD' 'DEPLACEMENTS';
  2154.  
  2155. ****************************************************
  2156. * MODIFICATION DES CHAMPS THETA ET PI SI GRANDE ROT
  2157. ****************************************************
  2158. SI IPAP;
  2159. SI IGDER;
  2160. FORM SUPTAB.'ROTATION_RIGIDIFIANTE'.IABC;
  2161. SUPTAB.'CHAMP_THETA' UTILTETA = CH_THETA SUPTAB;
  2162. SI (EGA IINTE 4);
  2163. SI (NON (EXIS SUPTAB 'FRONT_FISSURE_2'));
  2164. SUPTAB.'COUCHE' = (SUPTAB.'COUCHE') - 1;
  2165. SUPTAB.'PI' UTILPI = CH_THETA SUPTAB;
  2166. SUPTAB.'COUCHE' = (SUPTAB.'COUCHE') + 1;
  2167. SINON;
  2168. P1 = SUPTAB.'FRONT_FISSURE';
  2169. SUPTAB.'FRONT_FISSURE' = SUPTAB.'FRONT_FISSURE_2';
  2170. SUPTAB.'FISSURE' = SUPTAB.'FISSURE_2';
  2171. SUPTAB.'PI' UTILPI = CH_THETA SUPTAB;
  2172. SUPTAB.'FRONT_FISSURE' = P1;
  2173. FINSI;
  2174. FINSI;
  2175. FINSI;
  2176. FINSI;
  2177.  
  2178. ***************************************************
  2179. ********** TEMPERATURES A L INSTANT INST **********
  2180. ***************************************************
  2181. SI ITHER ;
  2182. SI IPAP;
  2183. SI (ITHER1);
  2184. TEPINT = 'TIRE' CHAR1 INST 'T' ;
  2185. SINON;
  2186. *bp, 2014-11-13 : ajout distinction cas ITHER et ITHER1
  2187. TEPINT = (SUPTAB.'SOLUTION_PASAPAS'.'TEMPERATURES'.IABC)
  2188. REDU ELTETA;
  2189. FINSI;
  2190. TEPINT = TEPINT - TALPH1 ;
  2191. SINON;
  2192. TEPINT = SUPTAB.'TEMPERATURES';
  2193. FINSI;
  2194. FINSI;
  2195.  
  2196.  
  2197. ***************************************************
  2198. ********** DEF IMPOSEE A L INSTANT INST **********
  2199. ***************************************************
  2200. SI IDEFI;
  2201. SI IPAP;
  2202. DEFINT = 'TIRE' CHAR1 INST 'DEFI' ;
  2203. SINON;
  2204. DEFINT = SUPTAB . 'DEFORMATIONS_IMPOSEES';
  2205. FINSI;
  2206. FINSI;
  2207.  
  2208. ***************************************************
  2209. ********** CONTACT FROTTANT **********
  2210. ***************************************************
  2211. SI IFROT;
  2212. SI IPAP;
  2213. *...todo
  2214. SINON;
  2215. * a priori DEPLACEMENT_FISSURE pas tres utile ...
  2216. SI (EXIS SUPTAB 'DEPLACEMENT_FISSURE');
  2217. WDEP = SUPTAB . 'DEPLACEMENT_FISSURE';
  2218. SINO;
  2219. WDEP = REDU (SUPTAB.'SOLUTION_RESO') MAICON;
  2220. FINS;
  2221. toto = EXTR WDEP 'MAIL';
  2222. SI (EGA (NBEL toto) 0);
  2223. MESS 'ERREUR : IL FAUT DEPLACEMENT_FISSURE si MODELE_FISSURE';
  2224. ERRE 21; QUIT G_THETA;
  2225. FINS;
  2226. SI (EXIS SUPTAB 'PRESSION_FISSURE');
  2227. SIGCON = SUPTAB . 'PRESSION_FISSURE';
  2228. SINO;
  2229. SIGCON = REDU SIGF OBJCON;
  2230. FINS;
  2231. * peut etre faire un test sur SIGCON ...
  2232. FINSI;
  2233. FINS;
  2234.  
  2235. *****************************************************
  2236. * CONTRAINTE RECALCULEE SI ITHER = VRAI et NON IPAP *
  2237. *****************************************************
  2238. SI (ITHER ET (NON IPAP));
  2239. SIGF = SIGF - ('THET' OBJMOD OBJMAT TEPINT);
  2240. FINSI;
  2241.  
  2242. ***************************************************
  2243. ************ MATERIAU A L INSTANT INST ************
  2244. ***************************************************
  2245. SI (MATVARI ET ITHER ET IPAP);
  2246. TEPABS = TEPINT + TALPH1 ;
  2247. MAT1 = VARI 'NUAG' OBJMOD OBJMAT (EXCO 'T' TEPABS 'T');
  2248. SINON;
  2249. MAT1 = OBJMAT;
  2250. *bp: ne devrait on pas ecrire ci dessous..? inutile?
  2251. * MAT1 = REDU OBJMOD OBJMAT
  2252. FINSI;
  2253.  
  2254. ***************************************************
  2255. ********* RIGIDITE TOTALE A L INSTANT INST ********
  2256. ***************************************************
  2257. *bp: utilite?
  2258. SI ( (EGA IINTE 4) OU ((EGA IINTE 99)
  2259. et (non IXFEM) et (EGA &DIME 3) ET (NON IDANS)) );
  2260. SI IPAP;
  2261. SI (MATVARI ET ITHER);
  2262. M1 = VARI 'NUAG' OBJMOD (EXCO 'T' TEPABS 'T')
  2263. (SUPTAB.'SOLUTION_PASAPAS'.'CARACTERISTIQUES');
  2264. SINON;
  2265. M1 = SUPTAB.'SOLUTION_PASAPAS'.'CARACTERISTIQUES';
  2266. FINSI;
  2267. RIGTOT = RIGI M1 (SUPTAB.'SOLUTION_PASAPAS'.'MODELE');
  2268. SINON;
  2269. RIGTOT = RIGI (SUPTAB.'CARACTERISTIQUES') (SUPTAB.'MODELE');
  2270. FINSI;
  2271. FINSI;
  2272.  
  2273. ********************************************************************
  2274. ****** CHARGEMENT MECANIQUE (FORCES NODALES) A L INSTANT INST ******
  2275. ********************************************************************
  2276. PREINT = FOR000;
  2277. *** SOLUTION_PASAPAS ******************************
  2278. SI IPAP;
  2279. SI (EXIS CHAR1 'MECA');
  2280. PREINT = PREINT + ((TIRE CHAR1 INST 'MECA') REDU ELTETA);
  2281. FINSI;
  2282. SI IMOPRES;
  2283. * Dans le cas ou il y a un modele de pression
  2284. MAILPTOT = EXTR MODPRE 'MAIL';
  2285. MATPRE = TIRE CHAR1 'PRES' INST;
  2286. * --> on isole la partie du MMODEL de pression qui est appliquee
  2287. * sur la fissure
  2288. MAILPF = INTE MAILPTOT (SUPTAB.'FISSURE');
  2289. SI ((NBEL MAILPF) > 0);
  2290. IPFISS = VRAI;
  2291. MODPF = REDU MODPRE MAILPF;
  2292. MATPF = REDU MATPRE MODPF;
  2293. FINSI;
  2294. * --> on calcule les forces nodales equivalentes aux pressions
  2295. * appliquees hors de la fissure
  2296. MAILPEXT = DIFF MAILPTOT MAILPF;
  2297. SI ((NBEL MAILPEXT) > 0);
  2298. MODPEXT = REDU MODPRE MAILPEXT;
  2299. MATPEXT = REDU MATPRE MODPEXT;
  2300. PREINT = PREINT + (PRES MODPEXT MATPEXT);
  2301. FINSI;
  2302. FINSI;
  2303. *** SOLUTION_RESO **********************************
  2304. SINON ;
  2305. SI (EXIS SUPTAB 'CHARGEMENTS_MECANIQUES');
  2306. PREINT = PREINT + (SUPTAB.'CHARGEMENTS_MECANIQUES' REDU ELTETA);
  2307. FINSI;
  2308. SI IMOPRES;
  2309. * Dans le cas ou il y a un modele de pression
  2310. MAILPTOT = EXTR MODPRE 'MAIL';
  2311. * --> on isole la partie du MMODEL de pression qui est appliquee sur
  2312. * la fissure
  2313. MAILPF = INTE MAILPTOT (SUPTAB.'FISSURE');
  2314. SI ((NBEL MAILPF) > 0);
  2315. IPFISS = VRAI;
  2316. MODPF = REDU MODPRE MAILPF;
  2317. MATPF = REDU MATPRE MODPF;
  2318. FINSI;
  2319. * --> on calcule les forces nodales equivalentes aux pressions
  2320. * appliquees hors de la fissure
  2321. MAILPEXT = DIFF MAILPTOT MAILPF;
  2322. SI ((NBEL MAILPEXT) > 0);
  2323. MODPEXT = REDU MODPRE MAILPEXT;
  2324. MATPEXT = REDU MATPRE MODPEXT;
  2325. PREINT = PREINT + (PRES MODPEXT MATPEXT);
  2326. FINSI;
  2327. FINSI;
  2328. FINSI;
  2329.  
  2330. **********************************************************************
  2331. ******** POUR LES PRESSIONS APPLIQUEES SUR LA FISSURE
  2332. * on calcule le MCHAML vectoriel de [pression * normale]
  2333. **********************************************************************
  2334. SI IPFISS;
  2335. * champ de normale unitaire au maillage de la fissure
  2336. MAT1F = MATE MODPF 'PRES' 1.;
  2337. NF1 = PRES MODPF MAT1F;
  2338. LCOMP = EXTR NF1 'COMP';
  2339. NF2 = CHAN 'CHAM' NF1 MODPF 'STRESSES';
  2340. XX = PSCA NF2 NF2 LCOMP LCOMP;
  2341. NF = NF2 / (XX**0.5);
  2342. * champ de pression normale au maillage de la fissure
  2343. PF = CHAN 'TYPE' MATPF 'FORCES';
  2344. PF = CHAN 'STRESSES' MODPF PF;
  2345. NCOMP = DIME LCOMP;
  2346. LCP = MOTS NCOMP*'PRES';
  2347. PNF = PF * NF LCP LCOMP LCOMP;
  2348. FINSI;
  2349.  
  2350.  
  2351. ****************************************************
  2352. *** SOLUTIONS AUXILAIRES SI DECOUPLAGE DES MODES ***
  2353. ****************************************************
  2354. * NBMIXT = nbre d integrale a calculer (=1 si J, =2 si K1 K2, =3
  2355. * si K1 K2 K3)
  2356. NBMIXT = 1;
  2357. IM = 0;
  2358. SI (EGA IINTE 99);
  2359. NBMIXT = 2;
  2360. SI (EGA &DIME 3);
  2361. NBMIXT = 3;
  2362. FINSI;
  2363.  
  2364. **** CONSTANTES MATERIAUX **************************
  2365. CHAM1 = (EXCO 'YOUN' MAT1) ET (EXCO 'NU ' MAT1);
  2366. * -CAS D UN MATERIAU HOMOGENE
  2367. SI (NON IDANS);
  2368. * on construit les champ auxilaires d'une solution d'un materiau
  2369. * homogene => on prend les valeurs de E et nu en pointe de fissure
  2370. CHPO1 = CHAN 'CHPO' OBJMOD CHAM1;
  2371. si(IXFEM);
  2372. CHPO1 = INT_COMP ELTETA CHPO1 (MANU 'POI1' PM);
  2373. fins;
  2374. SI (EGA (TYPE PM) 'MAILLAGE');
  2375. VYO_1 = (maxi (resu (exco CHPO1 'YOUN'))) / (nbno PM);
  2376. VNU_1 = (maxi (resu (exco CHPO1 'NU '))) / (nbno PM);
  2377. SINON;
  2378. VYO_1 = EXTR CHPO1 'YOUN' PM;
  2379. VNU_1 = EXTR CHPO1 'NU ' PM;
  2380. FINSI;
  2381. * Constante de Kolosov
  2382. SI (EGA &MODE 'PLANCONT');
  2383. KAP_1 = (3. - VNU_1) / (1. + VNU_1);
  2384. SINON;
  2385. KAP_1 = (3. - (4. * VNU_1));
  2386. FINSI;
  2387. * Module de cisaillement
  2388. MU_1 = VYO_1 / (2.*(1. + VNU_1));
  2389. * Constante C_MATE (= 1 / E^etoile)
  2390. SI (EGA &MODE 'PLANCONT');
  2391. C_MATE = 1. / VYO_1;
  2392. SINON;
  2393. C_MATE = (1. - (VNU_1*VNU_1)) / VYO_1;
  2394. FINSI;
  2395. * -CAS D UN BI-MATERIAU
  2396. SINON;
  2397. CHPO1 = CHAN 'CHPO' MODSUP (REDU CHAM1 MODSUP);
  2398. VYO_1 = EXTR CHPO1 'YOUN' PM;
  2399. VNU_1 = EXTR CHPO1 'NU ' PM;
  2400. CHPO1 = CHAN 'CHPO' MODINF (REDU CHAM1 MODINF);
  2401. VYO_2 = EXTR CHPO1 'YOUN' PM;
  2402. VNU_2 = EXTR CHPO1 'NU ' PM;
  2403. si(flmess);
  2404. mess ' mat1 mat2';
  2405. mess VYO_1 VYO_2;
  2406. mess VNU_1 VNU_2;
  2407. fins;
  2408. * Constante de Kolosov
  2409. SI (EGA &MODE 'PLANCONT');
  2410. KAP_1 = (3. - VNU_1) / (1. + VNU_1);
  2411. KAP_2 = (3. - VNU_2) / (1. + VNU_2);
  2412. SINON;
  2413. KAP_1 = (3. - (4. * VNU_1));
  2414. KAP_2 = (3. - (4. * VNU_2));
  2415. FINSI;
  2416. * Module de cisaillement
  2417. MU_1 = VYO_1 / (2.*(1. + VNU_1));
  2418. MU_2 = VYO_2 / (2.*(1. + VNU_2));
  2419. * Constante bi-metallique EPS1
  2420. VA1 = (KAP_1/MU_1) + (1./MU_2);
  2421. VA2 = (KAP_2/MU_2) + (1./MU_1);
  2422. EPS1 = (1./(2.*VALPI)) * (LOG (VA1/VA2));
  2423. * Constante C_MATE (= 1 / E^etoile)
  2424. COSH1 = VALPI * EPS1;
  2425. COSH1 = ((EXP COSH1) + (EXP (COSH1*(-1.)))) / 2.;
  2426. VA1 = (MU_1 + (KAP_1*MU_2)) * (MU_2 + (KAP_2*MU_1));
  2427. VA2 = MU_1 * MU_2 * ((MU_1*(1. + KAP_2)) + (MU_2*(1. + KAP_1)));
  2428. C_MATE = (COSH1*COSH1*VA1) / (4.*VA2);
  2429. mess 'EPS1=' EPS1 ' C_MATE=' C_MATE;
  2430. FINSI;
  2431. * rappel: G = C_MATE * (K1^2 + K2^2) + 1/MU * K3^2
  2432. * M = 2*C_MATE * (K1*K1^aux + K2*K2^aux) + 2/MU * K3*K3^aux
  2433.  
  2434. * on evite le cas 3d + EF standard
  2435. SI (NON ((EGA &DIME 3) ET (NON IXFEM)));
  2436.  
  2437. **** CHAMPS POUR SIMPLIFIER L ECRITURE ************
  2438. * (CHPOINT pour EF std // CHAMELEM si XFEM)
  2439. * -CAS D UN MATERIAU HOMOGENE
  2440. SI (NON IDANS);
  2441. SIN1T = sin TETA1; COS1T = cos TETA1;
  2442. SIN05T = sin (0.5*TETA1); COS05T = cos (0.5*TETA1);
  2443. SI IXFEM;
  2444. RM05 = (2.*VALPI*RAY1) ** -0.5 ;
  2445. COE_GU = RM05 / (4. * MU_1);
  2446. SIN15T = sin (1.5*TETA1); COS15T = cos (1.5*TETA1);
  2447. * KAP_1 = KAP_1 * UN1;
  2448. SINO;
  2449. COE_1 = ((RAY1/(2.*VALPI))**0.5) / (2.*MU_1);
  2450. FINS;
  2451. * -CAS D UN BI-MATERIAU
  2452. SINON;
  2453. EPSLGR = EPS1 * (LOG RAY1);
  2454. VA1 = COS (EPSLGR*180./VALPI);
  2455. VA2 = SIN (EPSLGR*180./VALPI);
  2456. BTA1 = ((0.5*VA1) + (EPS1*VA2)) / (0.25 + (EPS1*EPS1));
  2457. BTAPM1 = ((0.5*VA2) - (EPS1*VA1)) / (0.25 + (EPS1*EPS1));
  2458. DTA_1 = EXP (0. - ((VALPI - TETA1rad)*EPS1));
  2459. DTA_2 = EXP ((VALPI + TETA1rad)*EPS1);
  2460. GAM_1 = (KAP_1*DTA_1) - (DTA_1**(-1.));
  2461. GAM_2 = (KAP_2*DTA_2) - (DTA_2**(-1.));
  2462. GAMPM_1 = (KAP_1*DTA_1) + (DTA_1**(-1.));
  2463. GAMPM_2 = (KAP_2*DTA_2) + (DTA_2**(-1.));
  2464. COS05T = COS (TETA1/2.); SIN05T = SIN (TETA1/2.);
  2465. D_1 = (BTA1*GAM_1*COS05T) + (BTAPM1*GAMPM_1*SIN05T);
  2466. D_2 = (BTA1*GAM_2*COS05T) + (BTAPM1*GAMPM_2*SIN05T);
  2467. DPM_1 = (BTAPM1*GAM_1*COS05T) - (BTA1*GAMPM_1*SIN05T);
  2468. DPM_2 = (BTAPM1*GAM_2*COS05T) - (BTA1*GAMPM_2*SIN05T);
  2469. GTAR1 = EPSLGR + (0.5*TETA1rad);
  2470. CVA_1 = (SIN TETA1) * (SIN (GTAR1*180./VALPI));
  2471. CVA_2 = (SIN TETA1) * (COS (GTAR1*180./VALPI));
  2472. COE_1 = ((RAY1/(2.*VALPI))**0.5) / (4.*MU_1);
  2473. COE_2 = ((RAY1/(2.*VALPI))**0.5) / (4.*MU_2);
  2474. FINSI;
  2475.  
  2476. fins;
  2477.  
  2478. FINSI;
  2479.  
  2480.  
  2481.  
  2482.  
  2483. * BOUCLE SUR LES INTEGRALES A CALCULER ==============================*
  2484. REPETER BOUCMIX NBMIXT;
  2485. IM = IM + 1;
  2486.  
  2487. ****************************************************
  2488. **** CHAMPS AUXILIAIRES SI DECOUPLAGE **************
  2489. * Il existe plusieurs manieres de creer les champs aux :
  2490. * 1. en utilisant l expression analytique de grad(U) et sigma
  2491. * 2. en utilisant l expression analytique de U et en calculant
  2492. * sigma, Fint=Bsigma, grad(U) ...
  2493. * 3. en appliquant une pression/cisaillement sur les faces de la fissure
  2494. * et en resolvant le pb associe
  2495. * On utilise la 1ere lorsqu'on peut, la 2eme sinon
  2496. SI (EGA IINTE 99);
  2497.  
  2498.  
  2499. **** MOTMIX et MOTMIA **************************
  2500. SI (IM EGA 1); MOTMIX = MOT 'I'; MOTMIA = MOT ' I'; FINSI;
  2501. SI (IM EGA 2); MOTMIX = MOT 'II'; MOTMIA = MOT ' II'; FINSI;
  2502. SI (IM EGA 3); MOTMIX = MOT 'III';MOTMIA = MOT 'III'; FINSI;
  2503. MESS 'CHAMPS AUXILIAIRES mode' MOTMIA;
  2504.  
  2505.  
  2506. **** METHODE ANALYTIQUE PURE *******************
  2507.  
  2508. * -CAS D UN MATERIAU HOMOGENE 2D et 3D --------------------
  2509. * SI (IXFEM et (EGA &DIME 2) ET (NON IDANS));
  2510. SI (IXFEM ET (NON IDANS));
  2511. si(flmess);
  2512. mess 'MATERIAU HOMOGENE XFEM: METHODE ANALYTIQUE';
  2513. fins;
  2514.  
  2515. * DERIVEES REPERE CYLINDRIQUE / COORDONNEES GLOBALES
  2516. * R,X = DRDX R,Y = DRDY
  2517. * T,X = (1/R)*DTDX T,Y = (1/R)*DTDY
  2518. DRDX = ( COS1T*(EXCO GLV7 'UX,X' 'SCAL'))
  2519. + (SDIR1*SIN1T*(EXCO GLV7 'UY,X' 'SCAL')) ;
  2520. DRDY = ( COS1T*(EXCO GLV7 'UX,Y' 'SCAL'))
  2521. + (SDIR1*SIN1T*(EXCO GLV7 'UY,Y' 'SCAL')) ;
  2522. DTDX = ( -1.*SIN1T*(EXCO GLV7 'UX,X' 'SCAL'))
  2523. + (SDIR1*COS1T*(EXCO GLV7 'UY,X' 'SCAL'));
  2524. DTDY = ( -1.*SIN1T*(EXCO GLV7 'UX,Y' 'SCAL'))
  2525. + (SDIR1*COS1T*(EXCO GLV7 'UY,Y' 'SCAL'));
  2526. si(EGA &DIME 3);
  2527. DRDZ = ( COS1T*(EXCO GLV7 'UX,Z' 'SCAL'))
  2528. + (SDIR1*SIN1T*(EXCO GLV7 'UY,Z' 'SCAL')) ;
  2529. DTDZ = ( -1.*SIN1T*(EXCO GLV7 'UX,Z' 'SCAL'))
  2530. + (SDIR1*COS1T*(EXCO GLV7 'UY,Z' 'SCAL'));
  2531. fins;
  2532.  
  2533. * -debut du cas contact frottant IFROT (btrolle 19/02/2013)
  2534. * ajout des solutions analytiques du saut sur les levres de la fissure
  2535. * projection de psi1 sur la fissure et calcul de psi,x
  2536. 'SI' IFROT;
  2537.  
  2538. * PSI en CHAML aux PG sur la fissure utilise pour calcul du gradient
  2539. * on selectionne la partie de psi2 non nulle (= dans le champ theta)
  2540. SI (EGA &DIME 2);
  2541. * contour du domaine theta
  2542. con1 = 'CONTOUR' ELTETA;
  2543. * maillage support pour l'integration
  2544. mai1 = 'INCLUSION' MAICON con1 'STRI';
  2545. * OBJCON2 = MODE mai1 'MECANIQUE' 'ZCO2';
  2546. OBJCON2 = REDU OBJCON mai1;
  2547. 'SINON';
  2548. * maillage support pour l'integration
  2549. mai1 = 'INCLUSION' ('EXTRAIRE' OBJCON 'MAIL') ELTETA 'VOLU'
  2550. 'STRI';
  2551. * OBJCON2 = 'MODELISER' mai1 'MECANIQUE' 'ZCO3';
  2552. OBJCON2 = REDU OBJCON mai1;
  2553. 'FINSI';
  2554. PSI1e = CHAN 'CHAM' PSI1 OBJMOD 'NOEUDS';
  2555. PSI2 = PROI OBJCON2 PSI1e 'STRESSES';
  2556. * PSI en CHPOINT sur la fissure utilise pour calcul du repere local
  2557. PSI3 = PROI MAICON PSI1e;
  2558. TesPsi = PSI2 'MASQUE' 'INFERIEUR'(-1E-15) ;
  2559. * PSI2B = 'CHANGER' 'CHAM' (TesPsi * (-1.*PSI2) ('MOTS' 'PSI') ('MOTS'
  2560. * ('MOTS' 'PSI')) OBJCON 'STRESSES';
  2561. PSI2B = (TesPsi * (-1.*PSI2) ('MOTS' 'PSI') ('MOTS' 'PSI')
  2562. ('MOTS' 'PSI'));
  2563. * 'MESSAGE' ' PSI2B = '; 'LISTE' PSI2B;
  2564. * terme sqrt(r/2pI) et sa derivee,r
  2565. RM05B = ((PSI2B/(2.*VALPI)) **0.5);
  2566. RM05BR =0.5*((2.*VALPI*PSI2B)**-0.5);
  2567. * Change le nom pour pouvoir calculer grad avec ZCO
  2568. LV72 = (PSI3 NOMC 'AX')
  2569. et (MANU 'CHPO' ('EXTRAIRE' OBJCON2 'MAIL') 1 'AY ' 0.
  2570. 'NATURE' 'DIFFUS')
  2571. et (MANU 'CHPO' ('EXTRAIRE' OBJCON2 'MAIL') 1 'AZ ' 0.
  2572. 'NATURE' 'DIFFUS');
  2573. GLV72 = 'CHANGER' (GRAD LV72 OBJCON2) 'TYPE' 'SCALAIRE';
  2574. * 'MESSAGE' ' GLV72 =';'LISTE' GLV72 ;
  2575. 'SI' (&DIME 'EGA' 2);
  2576. * Angle ALPHA1 de passage local -> global
  2577. NGPSI2 = ( ((EXCO GLV72 'AX,X' 'SCAL')**2)
  2578. + ((EXCO GLV72 'AX,Y' 'SCAL')**2) )**(0.5) ;
  2579. COS1AB = ( (EXCO GLV72 'AX,Y' 'SCAL') / NGPSI2) ;
  2580. SIN1AB = ( (EXCO GLV72 'AX,X' 'SCAL') / NGPSI2) ;
  2581. 'SINON';
  2582. * Angle ALPHA1 de passage local -> global
  2583. NGPSI2 = ( ((EXCO GLV72 'AX,X' 'SCAL')**2)
  2584. + ((EXCO GLV72 'AX,Y' 'SCAL')**2)</